目次

このレポートでは、Weekly_HSP_Projectの分析経過を報告します。分析の構成は以下のとおりです。分析の再現性を担保するために用いたコードも記しています。

  • （1）前処理
  • （2）相関分析
  • （3）Roisman’s Approach（主効果モデルと交互作用効果モデルのF比を算出するため）
  • （4）時点別のWidaman’s Approach（メイン分析）
  • （5）1か月間のWidaman’s Approach（下位分析）
  • （6）Widaman’s Approachのグラフ
  • （7）Additional Analysis

（1）前処理

1-1. ローデータの読み込み

#tidyverseパッケージ読み込み
library(tidyverse)
## -- Attaching packages ----------------------------------------- tidyverse 1.2.1 --
## √ ggplot2 2.2.1     √ purrr   0.2.5
## √ tibble  1.4.2     √ dplyr   0.7.6
## √ tidyr   0.8.1     √ stringr 1.3.0
## √ readr   1.1.1     √ forcats 0.3.0
## -- Conflicts -------------------------------------------- tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()
#データ読み込み
lowdata <- read_csv("lowdata_4timepoints.csv", na = c(".", ""))
## Parsed with column specification:
## cols(
##   .default = col_integer()
## )
## See spec(...) for full column specifications.
lowdata$gender_T1 <- factor(lowdata$gender_T1) #性別をfactor型に変換
lowdata$gender_T2 <- factor(lowdata$gender_T2) #性別をfactor型に変換
lowdata$gender_T3 <- factor(lowdata$gender_T3) #性別をfactor型に変換
lowdata$gender_T4 <- factor(lowdata$gender_T4) #性別をfactor型に変換
head(lowdata) #先頭6行確認
names(lowdata) #変数名確認
##  [1] "ID"        "school"    "grade"     "age_T1"    "gender_T1"
##  [6] "hsc1_T1"   "hsc2_T1"   "hsc3_T1"   "hsc4_T1"   "hsc5_T1"  
## [11] "hsc6_T1"   "hsc7_T1"   "hsc8_T1"   "hsc9_T1"   "hsc10_T1" 
## [16] "hsc11_T1"  "hsc12_T1"  "wb1_T1"    "wb2_T1"    "wb3_T1"   
## [21] "wb4_T1"    "wb5_T1"    "ev1_T1"    "ev2_T1"    "age_T2"   
## [26] "gender_T2" "hsc1_T2"   "hsc2_T2"   "hsc3_T2"   "hsc4_T2"  
## [31] "hsc5_T2"   "hsc6_T2"   "hsc7_T2"   "hsc8_T2"   "hsc9_T2"  
## [36] "hsc10_T2"  "hsc11_T2"  "hsc12_T2"  "wb1_T2"    "wb2_T2"   
## [41] "wb3_T2"    "wb4_T2"    "wb5_T2"    "ev1_T2"    "ev2_T2"   
## [46] "age_T3"    "gender_T3" "hsc1_T3"   "hsc2_T3"   "hsc3_T3"  
## [51] "hsc4_T3"   "hsc5_T3"   "hsc6_T3"   "hsc7_T3"   "hsc8_T3"  
## [56] "hsc9_T3"   "hsc10_T3"  "hsc11_T3"  "hsc12_T3"  "wb1_T3"   
## [61] "wb2_T3"    "wb3_T3"    "wb4_T3"    "wb5_T3"    "ev1_T3"   
## [66] "ev2_T3"    "age_T4"    "gender_T4" "hsc1_T4"   "hsc2_T4"  
## [71] "hsc3_T4"   "hsc4_T4"   "hsc5_T4"   "hsc6_T4"   "hsc7_T4"  
## [76] "hsc8_T4"   "hsc9_T4"   "hsc10_T4"  "hsc11_T4"  "hsc12_T4" 
## [81] "wb1_T4"    "wb2_T4"    "wb3_T4"    "wb4_T4"    "wb5_T4"   
## [86] "ev1_T4"    "ev2_T4"

1-2. 下位尺度得点作成

data <- lowdata %>% 
  dplyr::mutate(eoe_T1 = (hsc4_T1 + hsc6_T1 + hsc8_T1 + hsc9_T1 + hsc12_T1)/5, na.rm = TRUE) %>% #EOE_T1の平均
  dplyr::mutate(lst_T1 = (hsc2_T1 + hsc11_T1)/2, na.rm = TRUE) %>% #LST_T1の平均
  dplyr::mutate(aes_T1 = (hsc5_T1 + hsc10_T1 + hsc1_T1 + hsc3_T1)/4, na.rm = TRUE) %>% #AES_T1の平均
  dplyr::mutate(hsc_T1 = (eoe_T1 + lst_T1 + aes_T1)/3, na.rm = TRUE) %>% #HSC_T1の平均
  dplyr::mutate(eoe_T2 = (hsc4_T2 + hsc6_T2 + hsc8_T2 + hsc9_T2 + hsc12_T2)/5, na.rm = TRUE) %>% #EOE_T2の平均
  dplyr::mutate(lst_T2 = (hsc2_T2 + hsc11_T2)/2, na.rm = TRUE) %>% #LST_T2の平均
  dplyr::mutate(aes_T2 = (hsc5_T2 + hsc10_T2 + hsc1_T2 + hsc3_T2)/4, na.rm = TRUE) %>% #AES_T2の平均
  dplyr::mutate(hsc_T2 = (eoe_T2 + lst_T2 + aes_T2)/3, na.rm = TRUE)  %>% #HSC_T2の平均
  dplyr::mutate(eoe_T3 = (hsc4_T3 + hsc6_T3 + hsc8_T3 + hsc9_T3 + hsc12_T3)/5, na.rm = TRUE) %>% #EOE_T3の平均
  dplyr::mutate(lst_T3 = (hsc2_T3 + hsc11_T3)/2, na.rm = TRUE) %>% #LST_T3の平均
  dplyr::mutate(aes_T3 = (hsc5_T3 + hsc10_T3 + hsc1_T3 + hsc3_T3)/4, na.rm = TRUE) %>% #AES_T3の平均
  dplyr::mutate(hsc_T3 = (eoe_T3 + lst_T3 + aes_T3)/3, na.rm = TRUE) %>% #HSC_T3の平均
  dplyr::mutate(eoe_T4 = (hsc4_T4 + hsc6_T4 + hsc8_T4 + hsc9_T4 + hsc12_T4)/5, na.rm = TRUE) %>% #EOE_T4の平均
  dplyr::mutate(lst_T4 = (hsc2_T4 + hsc11_T4)/2, na.rm = TRUE) %>% #LST_T4の平均
  dplyr::mutate(aes_T4 = (hsc5_T4 + hsc10_T4 + hsc1_T4 + hsc3_T4)/4, na.rm = TRUE) %>% #AES_T4の平均
  dplyr::mutate(hsc_T4 = (eoe_T4 + lst_T4 + aes_T4)/3, na.rm = TRUE) %>% #HSC_T4の平均
  dplyr::mutate(hsc_onemonth = (hsc_T1 + hsc_T2 + hsc_T3 + hsc_T4)/4, na.rm = TRUE) %>% #1ヵ月間のHSC平均
  dplyr::mutate(wb_T1 = (wb1_T1 + wb2_T1 + wb3_T1 + wb4_T1 + wb5_T1)/5, na.rm = TRUE) %>% #wb_T1の平均
  dplyr::mutate(wb_T2 = (wb1_T2 + wb2_T2 + wb3_T2 + wb4_T2 + wb5_T2)/5, na.rm = TRUE) %>% #wb_T2の平均
  dplyr::mutate(wb_T3 = (wb1_T3 + wb2_T3 + wb3_T3 + wb4_T3 + wb5_T3)/5, na.rm = TRUE) %>% #wb_T3の平均
  dplyr::mutate(wb_T4 = (wb1_T4 + wb2_T4 + wb3_T4 + wb4_T4 + wb5_T4)/5, na.rm = TRUE) %>% #wb_T4の平均
  dplyr::mutate(wb_onemonth = (wb_T1 + wb_T2 + wb_T3 + wb_T4)/4, na.rm = TRUE) %>% #1か月間のwb平均
  dplyr::mutate(ev_T1 = (as.numeric(ev1_T1) + as.numeric(ev2_T1))/2, na.rm = TRUE) %>% #event_T1の平均 #as.numericにしないとエラーが出る
  dplyr::mutate(ev_T2 = (as.numeric(ev1_T2) + as.numeric(ev2_T2))/2, na.rm = TRUE) %>% #event_T2の平均
  dplyr::mutate(ev_T3 = (as.numeric(ev1_T3) + as.numeric(ev2_T3))/2, na.rm = TRUE) %>% #event_T3の平均
  dplyr::mutate(ev_T4 = (as.numeric(ev1_T4) + as.numeric(ev2_T4))/2, na.rm = TRUE) %>% #event_T4の平均
  dplyr::mutate(ev_onemonth = (ev_T1 + ev_T2 + ev_T3 + ev_T4)/4, na.rm = TRUE) %>% #1か月間のev平均
  dplyr::select(-na.rm) #謎にna.rmという変数が勝手に作成されてしまうのでそれを除外

head(data) #先頭6行確認
names(data) #変数名確認
##   [1] "ID"           "school"       "grade"        "age_T1"      
##   [5] "gender_T1"    "hsc1_T1"      "hsc2_T1"      "hsc3_T1"     
##   [9] "hsc4_T1"      "hsc5_T1"      "hsc6_T1"      "hsc7_T1"     
##  [13] "hsc8_T1"      "hsc9_T1"      "hsc10_T1"     "hsc11_T1"    
##  [17] "hsc12_T1"     "wb1_T1"       "wb2_T1"       "wb3_T1"      
##  [21] "wb4_T1"       "wb5_T1"       "ev1_T1"       "ev2_T1"      
##  [25] "age_T2"       "gender_T2"    "hsc1_T2"      "hsc2_T2"     
##  [29] "hsc3_T2"      "hsc4_T2"      "hsc5_T2"      "hsc6_T2"     
##  [33] "hsc7_T2"      "hsc8_T2"      "hsc9_T2"      "hsc10_T2"    
##  [37] "hsc11_T2"     "hsc12_T2"     "wb1_T2"       "wb2_T2"      
##  [41] "wb3_T2"       "wb4_T2"       "wb5_T2"       "ev1_T2"      
##  [45] "ev2_T2"       "age_T3"       "gender_T3"    "hsc1_T3"     
##  [49] "hsc2_T3"      "hsc3_T3"      "hsc4_T3"      "hsc5_T3"     
##  [53] "hsc6_T3"      "hsc7_T3"      "hsc8_T3"      "hsc9_T3"     
##  [57] "hsc10_T3"     "hsc11_T3"     "hsc12_T3"     "wb1_T3"      
##  [61] "wb2_T3"       "wb3_T3"       "wb4_T3"       "wb5_T3"      
##  [65] "ev1_T3"       "ev2_T3"       "age_T4"       "gender_T4"   
##  [69] "hsc1_T4"      "hsc2_T4"      "hsc3_T4"      "hsc4_T4"     
##  [73] "hsc5_T4"      "hsc6_T4"      "hsc7_T4"      "hsc8_T4"     
##  [77] "hsc9_T4"      "hsc10_T4"     "hsc11_T4"     "hsc12_T4"    
##  [81] "wb1_T4"       "wb2_T4"       "wb3_T4"       "wb4_T4"      
##  [85] "wb5_T4"       "ev1_T4"       "ev2_T4"       "eoe_T1"      
##  [89] "lst_T1"       "aes_T1"       "hsc_T1"       "eoe_T2"      
##  [93] "lst_T2"       "aes_T2"       "hsc_T2"       "eoe_T3"      
##  [97] "lst_T3"       "aes_T3"       "hsc_T3"       "eoe_T4"      
## [101] "lst_T4"       "aes_T4"       "hsc_T4"       "hsc_onemonth"
## [105] "wb_T1"        "wb_T2"        "wb_T3"        "wb_T4"       
## [109] "wb_onemonth"  "ev_T1"        "ev_T2"        "ev_T3"       
## [113] "ev_T4"        "ev_onemonth"
# write.csv(data, file = "data_for_analysis.csv", na = ".") #csvで書き出し

1-3. 度数分布とヒストグラム

library(plotly)

#性別T1の度数分布とヒストグラム
gender_T1_count <- dplyr::count(data, gender_T1)
knitr::kable(gender_T1_count) #テーブル化
gender_T1 n
0 43
1 71 
a <- ggplot(data = data, mapping = aes(x = gender_T1, fill = factor(gender_T1))) + geom_bar() #視覚化
ggplotly(a) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#性別T2の度数分布とヒストグラム
gender_T2_count <- dplyr::count(data, gender_T2)
knitr::kable(gender_T2_count) #テーブル化
gender_T2 n
0 38
1 62
NA 14 
b <- ggplot(data = data, mapping = aes(x = gender_T2, fill = factor(gender_T2))) + geom_bar() #視覚化
ggplotly(b) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#性別T3の度数分布とヒストグラム
gender_T3_count <- dplyr::count(data, gender_T3)
knitr::kable(gender_T3_count) #テーブル化
gender_T3 n
0 38
1 67
NA 9 
c <- ggplot(data = data, mapping = aes(x = gender_T3, fill = factor(gender_T3))) + geom_bar() #視覚化
ggplotly(c) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#性別T4の度数分布とヒストグラム
gender_T4_count <- dplyr::count(data, gender_T4)
knitr::kable(gender_T4_count) #テーブル化
gender_T4 n
0 39
1 67
NA 8 
d <- ggplot(data = data, mapping = aes(x = gender_T4, fill = factor(gender_T4))) + geom_bar() #視覚化
ggplotly(d) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc1_T1の度数分布とヒストグラム
hsc1_T1_count <- dplyr::count(data, hsc1_T1)
knitr::kable(hsc1_T1_count) #テーブル化
hsc1_T1 n
1 2
2 8
3 10
4 16
5 48
6 19
7 11 
e <- ggplot(data = data, mapping = aes(x = hsc1_T1, fill = factor(hsc1_T1))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(e) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc2_T1の度数分布とヒストグラム
hsc2_T1_count <- dplyr::count(data, hsc2_T1)
knitr::kable(hsc2_T1_count) #テーブル化
hsc2_T1 n
1 3
2 12
3 10
4 20
5 29
6 24
7 16 
f <- ggplot(data = data, mapping = aes(x = hsc2_T1, fill = factor(hsc2_T1))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(f) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc3_T1の度数分布とヒストグラム
hsc3_T1_count <- dplyr::count(data, hsc3_T1)
knitr::kable(hsc3_T1_count) #テーブル化
hsc3_T1 n
2 4
3 4
4 12
5 23
6 35
7 35
NA 1 
g <- ggplot(data = data, mapping = aes(x = hsc3_T1, fill = factor(hsc3_T1))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(g) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc4_T1の度数分布とヒストグラム
hsc4_T1_count <- dplyr::count(data, hsc4_T1)
knitr::kable(hsc4_T1_count) #テーブル化
hsc4_T1 n
1 8
2 13
3 13
4 19
5 28
6 17
7 16 
h <- ggplot(data = data, mapping = aes(x = hsc4_T1, fill = factor(hsc4_T1))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(h) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc5_T1の度数分布とヒストグラム
hsc5_T1_count <- dplyr::count(data, hsc5_T1)
knitr::kable(hsc5_T1_count) #テーブル化
hsc5_T1 n
3 1
4 4
5 21
6 36
7 52 
i <- ggplot(data = data, mapping = aes(x = hsc5_T1, fill = factor(hsc5_T1))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(i) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc6_T1の度数分布とヒストグラム
hsc6_T1_count <- dplyr::count(data, hsc6_T1)
knitr::kable(hsc6_T1_count) #テーブル化
hsc6_T1 n
1 2
2 5
3 12
4 21
5 35
6 25
7 14 
j <- ggplot(data = data, mapping = aes(x = hsc6_T1, fill = factor(hsc6_T1))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(j) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc7_T1の度数分布とヒストグラム
hsc7_T1_count <- dplyr::count(data, hsc7_T1)
knitr::kable(hsc7_T1_count) #テーブル化
hsc7_T1 n
1 4
2 11
3 13
4 21
5 17
6 26
7 22 
k <- ggplot(data = data, mapping = aes(x = hsc7_T1, fill = factor(hsc7_T1))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(k) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc8_T1の度数分布とヒストグラム
hsc8_T1_count <- dplyr::count(data, hsc8_T1)
knitr::kable(hsc8_T1_count) #テーブル化
hsc8_T1 n
1 3
2 16
3 12
4 42
5 24
6 13
7 4 
l <- ggplot(data = data, mapping = aes(x = hsc8_T1, fill = factor(hsc8_T1))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(l) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc9_T1の度数分布とヒストグラム
hsc9_T1_count <- dplyr::count(data, hsc9_T1)
knitr::kable(hsc9_T1_count) #テーブル化
hsc9_T1 n
1 9
2 21
3 18
4 38
5 17
6 10
7 1 
m <- ggplot(data = data, mapping = aes(x = hsc9_T1, fill = factor(hsc9_T1))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(m) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc10_T1の度数分布とヒストグラム
hsc10_T1_count <- dplyr::count(data, hsc10_T1)
knitr::kable(hsc10_T1_count) #テーブル化
hsc10_T1 n
4 3
5 10
6 29
7 72 
n <- ggplot(data = data, mapping = aes(x = hsc10_T1, fill = factor(hsc10_T1))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(n) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc11_T1の度数分布とヒストグラム
hsc11_T1_count <- dplyr::count(data, hsc11_T1)
knitr::kable(hsc11_T1_count) #テーブル化
hsc11_T1 n
1 2
2 5
3 12
4 25
5 26
6 23
7 21 
o <- ggplot(data = data, mapping = aes(x = hsc11_T1, fill = factor(hsc11_T1))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(o) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc12_T1の度数分布とヒストグラム
hsc12_T1_count <- dplyr::count(data, hsc12_T1)
knitr::kable(hsc12_T1_count) #テーブル化
hsc12_T1 n
1 2
2 5
3 5
4 2
5 28
6 37
7 35 
p <- ggplot(data = data, mapping = aes(x = hsc12_T1, fill = factor(hsc12_T1))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(p) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc1_T2の度数分布とヒストグラム
hsc1_T2_count <- dplyr::count(data, hsc1_T2)
knitr::kable(hsc1_T2_count) #テーブル化
hsc1_T2 n
1 2
2 4
3 10
4 20
5 37
6 22
7 5
NA 14 
q <- ggplot(data = data, mapping = aes(x = hsc1_T2, fill = factor(hsc1_T2))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(q) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc2_T2の度数分布とヒストグラム
hsc2_T2_count <- dplyr::count(data, hsc2_T2)
knitr::kable(hsc2_T2_count) #テーブル化
hsc2_T2 n
1 1
2 8
3 12
4 13
5 30
6 24
7 12
NA 14 
r <- ggplot(data = data, mapping = aes(x = hsc2_T2, fill = factor(hsc2_T2))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(r) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc3_T2の度数分布とヒストグラム
hsc3_T2_count <- dplyr::count(data, hsc3_T2)
knitr::kable(hsc3_T2_count) #テーブル化
hsc3_T2 n
1 1
2 2
3 3
4 11
5 22
6 33
7 28
NA 14 
s <- ggplot(data = data, mapping = aes(x = hsc3_T2, fill = factor(hsc3_T2))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(s) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc4_T2の度数分布とヒストグラム
hsc4_T2_count <- dplyr::count(data, hsc4_T2)
knitr::kable(hsc4_T2_count) #テーブル化
hsc4_T2 n
1 7
2 11
3 10
4 11
5 27
6 25
7 9
NA 14 
t <- ggplot(data = data, mapping = aes(x = hsc4_T2, fill = factor(hsc4_T2))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(t) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc5_T2の度数分布とヒストグラム
hsc5_T2_count <- dplyr::count(data, hsc5_T2)
knitr::kable(hsc5_T2_count) #テーブル化
hsc5_T2 n
3 2
4 6
5 16
6 30
7 46
NA 14 
u <- ggplot(data = data, mapping = aes(x = hsc5_T2, fill = factor(hsc5_T2))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(u) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc6_T2の度数分布とヒストグラム
hsc6_T2_count <- dplyr::count(data, hsc6_T2)
knitr::kable(hsc6_T2_count) #テーブル化
hsc6_T2 n
1 1
2 8
3 8
4 13
5 40
6 20
7 10
NA 14 
v <- ggplot(data = data, mapping = aes(x = hsc6_T2, fill = factor(hsc6_T2))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(v) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc7_T2の度数分布とヒストグラム
hsc7_T2_count <- dplyr::count(data, hsc7_T2)
knitr::kable(hsc7_T2_count) #テーブル化
hsc7_T2 n
1 3
2 9
3 9
4 23
5 10
6 27
7 19
NA 14 
w <- ggplot(data = data, mapping = aes(x = hsc7_T2, fill = factor(hsc7_T2))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(w) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc8_T2の度数分布とヒストグラム
hsc8_T2_count <- dplyr::count(data, hsc8_T2)
knitr::kable(hsc8_T2_count) #テーブル化
hsc8_T2 n
2 11
3 16
4 23
5 31
6 13
7 5
NA 15 
neko <- ggplot(data = data, mapping = aes(x = hsc8_T2, fill = factor(hsc8_T2))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(neko) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc9_T2の度数分布とヒストグラム
hsc9_T2_count <- dplyr::count(data, hsc9_T2)
knitr::kable(hsc9_T2_count) #テーブル化
hsc9_T2 n
1 4
2 20
3 15
4 30
5 17
6 9
7 5
NA 14 
y <- ggplot(data = data, mapping = aes(x = hsc9_T2, fill = factor(hsc9_T2))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(y) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc10_T2の度数分布とヒストグラム
hsc10_T2_count <- dplyr::count(data, hsc10_T2)
knitr::kable(hsc10_T2_count) #テーブル化
hsc10_T2 n
2 1
3 2
4 1
5 12
6 31
7 53
NA 14 
z <- ggplot(data = data, mapping = aes(x = hsc10_T2, fill = factor(hsc10_T2))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(z) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc11_T2の度数分布とヒストグラム
hsc11_T2_count <- dplyr::count(data, hsc11_T2)
knitr::kable(hsc11_T2_count) #テーブル化
hsc11_T2 n
1 2
2 10
3 11
4 14
5 30
6 18
7 14
NA 15 
aa <- ggplot(data = data, mapping = aes(x = hsc11_T2, fill = factor(hsc11_T2))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(aa) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc12_T2の度数分布とヒストグラム
hsc12_T2_count <- dplyr::count(data, hsc12_T2)
knitr::kable(hsc12_T2_count) #テーブル化
hsc12_T2 n
1 1
2 5
3 3
4 9
5 22
6 36
7 24
NA 14 
bb <- ggplot(data = data, mapping = aes(x = hsc12_T2, fill = factor(hsc12_T2))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(bb) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc1_T3の度数分布とヒストグラム
hsc1_T3_count <- dplyr::count(data, hsc1_T3)
knitr::kable(hsc1_T3_count) #テーブル化
hsc1_T3 n
1 1
2 3
3 12
4 19
5 40
6 24
7 6
NA 9 
cc <- ggplot(data = data, mapping = aes(x = hsc1_T3, fill = factor(hsc1_T3))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(cc) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc2_T3の度数分布とヒストグラム
hsc2_T3_count <- dplyr::count(data, hsc2_T3)
knitr::kable(hsc2_T3_count) #テーブル化
hsc2_T3 n
1 2
2 5
3 9
4 11
5 28
6 35
7 15
NA 9 
dd <- ggplot(data = data, mapping = aes(x = hsc2_T3, fill = factor(hsc2_T3))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(dd) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc3_T3の度数分布とヒストグラム
hsc3_T3_count <- dplyr::count(data, hsc3_T3)
knitr::kable(hsc3_T3_count) #テーブル化
hsc3_T3 n
2 1
3 2
4 6
5 23
6 29
7 44
NA 9 
ff <- ggplot(data = data, mapping = aes(x = hsc3_T3, fill = factor(hsc3_T3))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(ff) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc4_T3の度数分布とヒストグラム
hsc4_T3_count <- dplyr::count(data, hsc4_T3)
knitr::kable(hsc4_T3_count) #テーブル化
hsc4_T3 n
1 3
2 7
3 3
4 17
5 37
6 24
7 14
NA 9 
gg <- ggplot(data = data, mapping = aes(x = hsc4_T3, fill = factor(hsc4_T3))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(gg) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc5_T3の度数分布とヒストグラム
hsc5_T3_count <- dplyr::count(data, hsc5_T3)
knitr::kable(hsc5_T3_count) #テーブル化
hsc5_T3 n
2 2
3 2
4 4
5 15
6 24
7 58
NA 9 
hh <- ggplot(data = data, mapping = aes(x = hsc5_T3, fill = factor(hsc5_T3))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(hh) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc6_T3の度数分布とヒストグラム
hsc6_T3_count <- dplyr::count(data, hsc6_T3)
knitr::kable(hsc6_T3_count) #テーブル化
hsc6_T3 n
1 2
2 2
3 5
4 14
5 31
6 33
7 17
NA 10 
ii <- ggplot(data = data, mapping = aes(x = hsc6_T3, fill = factor(hsc6_T3))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(ii) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc7_T3の度数分布とヒストグラム
hsc7_T3_count <- dplyr::count(data, hsc7_T3)
knitr::kable(hsc7_T3_count) #テーブル化
hsc7_T3 n
1 5
2 11
3 8
4 22
5 13
6 23
7 23
NA 9 
jj <- ggplot(data = data, mapping = aes(x = hsc7_T3, fill = factor(hsc7_T3))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(jj) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc8_T3の度数分布とヒストグラム
hsc8_T3_count <- dplyr::count(data, hsc8_T3)
knitr::kable(hsc8_T3_count) #テーブル化
hsc8_T3 n
1 2
2 5
3 15
4 23
5 29
6 18
7 13
NA 9 
kk <- ggplot(data = data, mapping = aes(x = hsc8_T3, fill = factor(hsc8_T3))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(kk) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc9_T3の度数分布とヒストグラム
hsc9_T3_count <- dplyr::count(data, hsc9_T3)
knitr::kable(hsc9_T3_count) #テーブル化
hsc9_T3 n
1 6
2 15
3 16
4 29
5 25
6 10
7 4
NA 9 
ll <- ggplot(data = data, mapping = aes(x = hsc9_T3, fill = factor(hsc9_T3))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(ll) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc10_T3の度数分布とヒストグラム
hsc10_T3_count <- dplyr::count(data, hsc10_T3)
knitr::kable(hsc10_T3_count) #テーブル化
hsc10_T3 n
3 1
4 3
5 10
6 29
7 62
NA 9 
dog <- ggplot(data = data, mapping = aes(x = hsc10_T3, fill = factor(hsc10_T3))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(dog) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc11_T3の度数分布とヒストグラム
hsc11_T3_count <- dplyr::count(data, hsc11_T3)
knitr::kable(hsc11_T3_count) #テーブル化
hsc11_T3 n
1 3
2 4
3 10
4 22
5 25
6 25
7 16
NA 9 
mm <- ggplot(data = data, mapping = aes(x = hsc11_T3, fill = factor(hsc11_T3))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(mm) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc12_T3の度数分布とヒストグラム
hsc12_T3_count <- dplyr::count(data, hsc12_T3)
knitr::kable(hsc12_T3_count) #テーブル化
hsc12_T3 n
2 1
3 2
4 9
5 27
6 39
7 27
NA 9 
nn <- ggplot(data = data, mapping = aes(x = hsc12_T3, fill = factor(hsc12_T3))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(nn) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc1_T4の度数分布とヒストグラム
hsc1_T4_count <- dplyr::count(data, hsc1_T4)
knitr::kable(hsc1_T4_count) #テーブル化
hsc1_T4 n
1 1
2 2
3 15
4 17
5 41
6 27
7 3
NA 8 
oo <- ggplot(data = data, mapping = aes(x = hsc1_T4, fill = factor(hsc1_T4))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(oo) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc2_T4の度数分布とヒストグラム
hsc2_T4_count <- dplyr::count(data, hsc2_T4)
knitr::kable(hsc2_T4_count) #テーブル化
hsc2_T4 n
2 9
3 11
4 9
5 32
6 32
7 13
NA 8 
pp <- ggplot(data = data, mapping = aes(x = hsc2_T4, fill = factor(hsc2_T4))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(pp) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc3_T4の度数分布とヒストグラム
hsc3_T4_count <- dplyr::count(data, hsc3_T4)
knitr::kable(hsc3_T4_count) #テーブル化
hsc3_T4 n
2 2
3 2
4 9
5 21
6 29
7 43
NA 8 
qq <- ggplot(data = data, mapping = aes(x = hsc3_T4, fill = factor(hsc3_T4))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(qq) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc4_T4の度数分布とヒストグラム
hsc4_T4_count <- dplyr::count(data, hsc4_T4)
knitr::kable(hsc4_T4_count) #テーブル化
hsc4_T4 n
1 5
2 5
3 13
4 12
5 35
6 22
7 14
NA 8 
rr <- ggplot(data = data, mapping = aes(x = hsc4_T4, fill = factor(hsc4_T4))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(rr) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc5_T4の度数分布とヒストグラム
hsc5_T4_count <- dplyr::count(data, hsc5_T4)
knitr::kable(hsc5_T4_count) #テーブル化
hsc5_T4 n
2 1
3 4
4 3
5 19
6 23
7 54
NA 10 
ss <- ggplot(data = data, mapping = aes(x = hsc5_T4, fill = factor(hsc5_T4))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(ss) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc6_T4の度数分布とヒストグラム
hsc6_T4_count <- dplyr::count(data, hsc6_T4)
knitr::kable(hsc6_T4_count) #テーブル化
hsc6_T4 n
1 2
2 8
3 8
4 9
5 38
6 29
7 12
NA 8 
inu <- ggplot(data = data, mapping = aes(x = hsc6_T4, fill = factor(hsc6_T4))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(inu) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc7_T4の度数分布とヒストグラム
hsc7_T4_count <- dplyr::count(data, hsc7_T4)
knitr::kable(hsc7_T4_count) #テーブル化
hsc7_T4 n
1 4
2 9
3 11
4 16
5 18
6 27
7 21
NA 8 
tt <- ggplot(data = data, mapping = aes(x = hsc7_T4, fill = factor(hsc7_T4))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(tt) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc8_T4の度数分布とヒストグラム
hsc8_T4_count <- dplyr::count(data, hsc8_T4)
knitr::kable(hsc8_T4_count) #テーブル化
hsc8_T4 n
1 2
2 5
3 17
4 20
5 34
6 17
7 11
NA 8 
vv <- ggplot(data = data, mapping = aes(x = hsc8_T4, fill = factor(hsc8_T4))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(vv) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc9_T4の度数分布とヒストグラム
hsc9_T4_count <- dplyr::count(data, hsc9_T4)
knitr::kable(hsc9_T4_count) #テーブル化
hsc9_T4 n
1 6
2 13
3 19
4 30
5 24
6 11
7 3
NA 8 
ww <- ggplot(data = data, mapping = aes(x = hsc9_T4, fill = factor(hsc9_T4))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(ww) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc10_T4の度数分布とヒストグラム
hsc10_T4_count <- dplyr::count(data, hsc10_T4)
knitr::kable(hsc10_T4_count) #テーブル化
hsc10_T4 n
2 1
3 1
4 3
5 11
6 30
7 60
NA 8 
kame <- ggplot(data = data, mapping = aes(x = hsc10_T4, fill = factor(hsc10_T4))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(kame) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc11_T4の度数分布とヒストグラム
hsc11_T4_count <- dplyr::count(data, hsc11_T4)
knitr::kable(hsc11_T4_count) #テーブル化
hsc11_T4 n
1 2
2 10
3 11
4 18
5 28
6 22
7 15
NA 8 
yy <- ggplot(data = data, mapping = aes(x = hsc11_T4, fill = factor(hsc11_T4))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(yy) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc12_T4の度数分布とヒストグラム
hsc12_T4_count <- dplyr::count(data, hsc12_T4)
knitr::kable(hsc12_T4_count) #テーブル化
hsc12_T4 n
1 1
2 5
3 2
4 7
5 31
6 31
7 29
NA 8 
zz <- ggplot(data = data, mapping = aes(x = hsc12_T4, fill = factor(hsc12_T4))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(zz) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#wb1_T1の度数分布とヒストグラム
wb1_T1_count <- dplyr::count(data, wb1_T1)
knitr::kable(wb1_T1_count) #テーブル化
wb1_T1 n
0 1
1 6
2 27
3 39
4 31
5 10 
aaa <- ggplot(data = data, mapping = aes(x = wb1_T1, fill = factor(wb1_T1))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(aaa) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#wb2_T1の度数分布とヒストグラム
wb2_T1_count <- dplyr::count(data, wb2_T1)
knitr::kable(wb2_T1_count) #テーブル化
wb2_T1 n
0 2
1 12
2 31
3 40
4 23
5 6 
bbb <- ggplot(data = data, mapping = aes(x = wb2_T1, fill = factor(wb2_T1))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(bbb) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#wb3_T1の度数分布とヒストグラム
wb3_T1_count <- dplyr::count(data, wb3_T1)
knitr::kable(wb3_T1_count) #テーブル化
wb3_T1 n
0 2
1 11
2 26
3 36
4 28
5 10
NA 1 
ccc <- ggplot(data = data, mapping = aes(x = wb3_T1, fill = factor(wb3_T1))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(ccc) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#wb4_T1の度数分布とヒストグラム
wb4_T1_count <- dplyr::count(data, wb4_T1)
knitr::kable(wb4_T1_count) #テーブル化
wb4_T1 n
0 4
1 35
2 34
3 27
4 9
5 5 
ddd <- ggplot(data = data, mapping = aes(x = wb4_T1, fill = factor(wb4_T1))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(ddd) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#wb5_T1の度数分布とヒストグラム
wb5_T1_count <- dplyr::count(data, wb5_T1)
knitr::kable(wb5_T1_count) #テーブル化
wb5_T1 n
0 3
1 15
2 29
3 38
4 22
5 7 
eee <- ggplot(data = data, mapping = aes(x = wb5_T1, fill = factor(wb5_T1))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(eee) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#wb1_T2の度数分布とヒストグラム
wb1_T2_count <- dplyr::count(data, wb1_T2)
knitr::kable(wb1_T2_count) #テーブル化
wb1_T2 n
1 5
2 23
3 30
4 33
5 9
NA 14 
fff <- ggplot(data = data, mapping = aes(x = wb1_T2, fill = factor(wb1_T2))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(fff) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#wb2_T2の度数分布とヒストグラム
wb2_T2_count <- dplyr::count(data, wb2_T2)
knitr::kable(wb2_T2_count) #テーブル化
wb2_T2 n
1 7
2 23
3 28
4 32
5 9
NA 15 
ggg <- ggplot(data = data, mapping = aes(x = wb2_T2, fill = factor(wb2_T2))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(ggg) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#wb3_T2の度数分布とヒストグラム
wb3_T2_count <- dplyr::count(data, wb3_T2)
knitr::kable(wb3_T2_count) #テーブル化
wb3_T2 n
1 10
2 16
3 36
4 25
5 13
NA 14 
hhh <- ggplot(data = data, mapping = aes(x = wb3_T2, fill = factor(wb3_T2))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(hhh) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#wb4_T2の度数分布とヒストグラム
wb4_T2_count <- dplyr::count(data, wb4_T2)
knitr::kable(wb4_T2_count) #テーブル化
wb4_T2 n
0 2
1 26
2 29
3 23
4 12
5 8
NA 14 
iii <- ggplot(data = data, mapping = aes(x = wb4_T2, fill = factor(wb4_T2))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(iii) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#wb5_T2の度数分布とヒストグラム
wb5_T2_count <- dplyr::count(data, wb5_T2)
knitr::kable(wb5_T2_count) #テーブル化
wb5_T2 n
1 12
2 26
3 28
4 21
5 13
NA 14 
jjj <- ggplot(data = data, mapping = aes(x = wb5_T2, fill = factor(wb5_T2))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(jjj) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#wb1_T3の度数分布とヒストグラム
wb1_T3_count <- dplyr::count(data, wb1_T3)
knitr::kable(wb1_T3_count) #テーブル化
wb1_T3 n
0 1
1 6
2 18
3 36
4 28
5 16
NA 9 
kkk <- ggplot(data = data, mapping = aes(x = wb1_T3, fill = factor(wb1_T3))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(kkk) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#wb2_T3の度数分布とヒストグラム
wb2_T3_count <- dplyr::count(data, wb2_T3)
knitr::kable(wb2_T3_count) #テーブル化
wb2_T3 n
0 1
1 12
2 22
3 32
4 27
5 11
NA 9 
lll <- ggplot(data = data, mapping = aes(x = wb2_T3, fill = factor(wb2_T3))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(lll) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#wb3_T3の度数分布とヒストグラム
wb3_T3_count <- dplyr::count(data, wb3_T3)
knitr::kable(wb1_T3_count) #テーブル化
wb1_T3 n
0 1
1 6
2 18
3 36
4 28
5 16
NA 9 
mmm <- ggplot(data = data, mapping = aes(x = wb3_T3, fill = factor(wb3_T3))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(mmm) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#wb4_T3の度数分布とヒストグラム
wb4_T3_count <- dplyr::count(data, wb4_T3)
knitr::kable(wb4_T3_count) #テーブル化
wb4_T3 n
0 6
1 20
2 40
3 18
4 15
5 6
NA 9 
nnn <- ggplot(data = data, mapping = aes(x = wb4_T3, fill = factor(wb4_T3))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(nnn) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#wb5_T3の度数分布とヒストグラム
wb5_T3_count <- dplyr::count(data, wb5_T3)
knitr::kable(wb5_T3_count) #テーブル化
wb5_T3 n
0 1
1 16
2 27
3 38
4 16
5 7
NA 9 
ooo <- ggplot(data = data, mapping = aes(x = wb5_T3, fill = factor(wb5_T3))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(ooo) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#wb1_T4の度数分布とヒストグラム
wb1_T4_count <- dplyr::count(data, wb1_T4)
knitr::kable(wb1_T4_count) #テーブル化
wb1_T4 n
0 1
1 10
2 17
3 34
4 34
5 10
NA 8 
ppp <- ggplot(data = data, mapping = aes(x = wb1_T4, fill = factor(wb1_T4))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(ppp) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#wb2_T4の度数分布とヒストグラム
wb2_T4_count <- dplyr::count(data, wb2_T4)
knitr::kable(wb2_T4_count) #テーブル化
wb2_T4 n
0 3
1 14
2 24
3 32
4 21
5 12
NA 8 
qqq <- ggplot(data = data, mapping = aes(x = wb2_T4, fill = factor(wb2_T4))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(qqq) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#wb3_T4の度数分布とヒストグラム
wb3_T4_count <- dplyr::count(data, wb3_T4)
knitr::kable(wb3_T4_count) #テーブル化
wb3_T4 n
0 1
1 9
2 25
3 31
4 23
5 17
NA 8 
rrr <- ggplot(data = data, mapping = aes(x = wb3_T4, fill = factor(wb3_T4))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(rrr) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#wb5_T4の度数分布とヒストグラム
wb5_T4_count <- dplyr::count(data, wb5_T4)
knitr::kable(wb5_T4_count) #テーブル化
wb5_T4 n
0 4
1 12
2 25
3 30
4 20
5 15
NA 8 
sss <- ggplot(data = data, mapping = aes(x = wb5_T4, fill = factor(wb5_T4))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(sss) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#event1_T1の度数分布とヒストグラム
event1_T1_count <- dplyr::count(data, ev1_T1)
knitr::kable(event1_T1_count) #テーブル化
ev1_T1 n
-3 16
-2 11
-1 9
0 3
1 8
2 11
3 55
NA 1 
ttt <- ggplot(data = data, mapping = aes(x = ev1_T1, fill = factor(ev1_T1))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(ttt) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#event2_T1の度数分布とヒストグラム
event2_T1_count <- dplyr::count(data, ev2_T1)
knitr::kable(event2_T1_count) #テーブル化
ev2_T1 n
-3 21
-2 16
-1 8
0 5
1 2
2 19
3 42
NA 1 
uuu <- ggplot(data = data, mapping = aes(x = ev2_T1, fill = factor(ev2_T1))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(uuu) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#event1_T2の度数分布とヒストグラム
event1_T2_count <- dplyr::count(data, ev1_T2)
knitr::kable(event1_T2_count) #テーブル化
ev1_T2 n
-3 17
-2 7
-1 4
0 4
1 6
2 13
3 47
NA 16 
vvv <- ggplot(data = data, mapping = aes(x = ev1_T2, fill = factor(ev1_T2))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(vvv) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#event2_T2の度数分布とヒストグラム
event2_T2_count <- dplyr::count(data, ev2_T2)
knitr::kable(event2_T2_count) #テーブル化
ev2_T2 n
-3 20
-2 15
-1 5
0 1
1 8
2 17
3 29
NA 19 
www <- ggplot(data = data, mapping = aes(x = ev2_T2, fill = factor(ev2_T2))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(www) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#event1_T3の度数分布とヒストグラム
event1_T3_count <- dplyr::count(data, ev1_T3)
knitr::kable(event1_T3_count) #テーブル化
ev1_T3 n
-3 19
-2 6
-1 10
0 6
1 4
2 11
3 47
NA 11 
usagi <- ggplot(data = data, mapping = aes(x = ev1_T3, fill = factor(ev1_T3))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(usagi) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#event2_T3の度数分布とヒストグラム
event2_T3_count <- dplyr::count(data, ev2_T3)
knitr::kable(event2_T3_count) #テーブル化
ev2_T3 n
-3 22
-2 12
-1 4
0 5
1 13
2 13
3 34
NA 11 
yyy <- ggplot(data = data, mapping = aes(x = ev2_T3, fill = factor(ev2_T3))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(yyy) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#event1_T4の度数分布とヒストグラム
event1_T4_count <- dplyr::count(data, ev1_T4)
knitr::kable(event1_T4_count) #テーブル化
ev1_T4 n
-3 15
-2 5
-1 3
0 4
1 10
2 15
3 49
NA 13 
zzz <- ggplot(data = data, mapping = aes(x = ev1_T4, fill = factor(ev1_T4))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(zzz) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#event2_T4の度数分布とヒストグラム
event2_T4_count <- dplyr::count(data, ev2_T4)
knitr::kable(event2_T4_count) #テーブル化
ev2_T4 n
-3 15
-2 13
-1 10
0 9
1 9
2 14
3 31
NA 13 
aaaa <- ggplot(data = data, mapping = aes(x = ev2_T4, fill = factor(ev2_T4))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(aaaa) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#eoe_T1の度数分布とヒストグラム
eoe_T1_count <- dplyr::count(data, eoe_T1)
knitr::kable(eoe_T1_count) #テーブル化
eoe_T1 n
1.8 2
2.2 1
2.4 2
2.6 1
2.8 1
3.0 1
3.2 3
3.4 5
3.6 2
3.8 10
4.0 6
4.2 14
4.4 6
4.6 7
4.8 11
5.0 9
5.2 10
5.4 5
5.6 6
5.8 5
6.0 4
6.4 3 
bbbb <- ggplot(data = data, mapping = aes(x = eoe_T1, fill = factor(eoe_T1))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(bbbb) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#eoe_T2の度数分布とヒストグラム
eoe_T2_count <- dplyr::count(data, eoe_T2)
knitr::kable(eoe_T2_count) #テーブル化
eoe_T2 n
1.8 2
2.0 1
2.4 1
2.6 2
2.8 2
3.0 1
3.2 2
3.4 2
3.6 2
3.8 4
4.0 5
4.2 8
4.4 6
4.6 9
4.8 16
5.0 3
5.2 7
5.4 5
5.6 9
5.8 2
6.0 3
6.2 4
6.4 1
6.6 1
6.8 1
NA 15 
cccc <- ggplot(data = data, mapping = aes(x = eoe_T2, fill = factor(eoe_T2))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(cccc) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#eoe_T3の度数分布とヒストグラム
eoe_T3_count <- dplyr::count(data, eoe_T3)
knitr::kable(eoe_T3_count) #テーブル化
eoe_T3 n
2.0 1
2.2 1
2.4 1
2.6 1
3.0 2
3.2 1
3.6 1
3.8 4
4.0 3
4.2 5
4.4 7
4.6 10
4.8 8
5.0 14
5.2 11
5.4 11
5.6 7
5.8 3
6.0 2
6.2 2
6.4 5
6.6 2
7.0 2
NA 10 
dddd <- ggplot(data = data, mapping = aes(x = eoe_T3, fill = factor(eoe_T3))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(dddd) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#eoe_T4の度数分布とヒストグラム
eoe_T4_count <- dplyr::count(data, eoe_T4)
knitr::kable(eoe_T4_count) #テーブル化
eoe_T4 n
1.0 1
2.0 1
2.2 1
2.4 1
2.6 1
2.8 3
3.0 2
3.2 3
3.4 1
3.6 1
3.8 3
4.0 6
4.2 2
4.4 7
4.6 13
4.8 7
5.0 7
5.2 10
5.4 7
5.6 11
5.8 6
6.0 5
6.2 2
6.4 2
6.6 1
6.8 1
7.0 1
NA 8 
eeee <- ggplot(data = data, mapping = aes(x = eoe_T4, fill = factor(eoe_T4))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(eeee) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#lst_T1の度数分布とヒストグラム
lst_T1_count <- dplyr::count(data, lst_T1)
knitr::kable(lst_T1_count) #テーブル化
lst_T1 n
1.5 2
2.0 3
2.5 3
3.0 7
3.5 15
4.0 8
4.5 14
5.0 15
5.5 16
6.0 10
6.5 9
7.0 12 
ffff <- ggplot(data = data, mapping = aes(x = lst_T1, fill = factor(lst_T1))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(ffff) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#lst_T2の度数分布とヒストグラム
lst_T2_count <- dplyr::count(data, lst_T2)
knitr::kable(lst_T2_count) #テーブル化
lst_T2 n
1.0 1
2.0 6
2.5 4
3.0 5
3.5 6
4.0 9
4.5 11
5.0 18
5.5 13
6.0 12
6.5 7
7.0 7
NA 15 
gggg <- ggplot(data = data, mapping = aes(x = lst_T2, fill = factor(lst_T2))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(gggg) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#lst_T3の度数分布とヒストグラム
lst_T3_count <- dplyr::count(data, lst_T3)
knitr::kable(lst_T3_count) #テーブル化
lst_T3 n
1.0 1
1.5 1
2.0 2
2.5 1
3.0 8
3.5 5
4.0 13
4.5 7
5.0 17
5.5 13
6.0 19
6.5 7
7.0 11
NA 9 
hhhh <- ggplot(data = data, mapping = aes(x = lst_T3, fill = factor(lst_T3))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(hhhh) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#lst_T4の度数分布とヒストグラム
lst_T4_count <- dplyr::count(data, lst_T4)
knitr::kable(lst_T4_count) #テーブル化
lst_T4 n
2.0 6
2.5 3
3.0 9
3.5 4
4.0 10
4.5 8
5.0 22
5.5 11
6.0 18
6.5 6
7.0 9
NA 8 
iiii <- ggplot(data = data, mapping = aes(x = lst_T4, fill = factor(lst_T4))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(iiii) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#aes_T1の度数分布とヒストグラム
aes_T1_count <- dplyr::count(data, aes_T1)
knitr::kable(aes_T1_count) #テーブル化
aes_T1 n
3.25 1
4.25 1
4.50 2
4.75 6
5.00 6
5.25 15
5.50 9
5.75 22
6.00 21
6.25 11
6.50 9
6.75 5
7.00 5
NA 1 
jjjj <- ggplot(data = data, mapping = aes(x = aes_T1, fill = factor(aes_T1))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(jjjj) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#aes_T2の度数分布とヒストグラム
aes_T2_count <- dplyr::count(data, aes_T2)
knitr::kable(aes_T2_count) #テーブル化
aes_T2 n
2.50 1
3.50 1
4.00 1
4.50 3
4.75 3
5.00 10
5.25 12
5.50 15
5.75 11
6.00 13
6.25 15
6.50 6
6.75 6
7.00 3
NA 14 
kkkk <- ggplot(data = data, mapping = aes(x = aes_T2, fill = factor(aes_T2))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(kkkk) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#aes_T3の度数分布とヒストグラム
aes_T3_count <- dplyr::count(data, aes_T3)
knitr::kable(aes_T3_count) #テーブル化
aes_T3 n
4.00 2
4.25 1
4.50 2
4.75 1
5.00 10
5.25 9
5.50 13
5.75 15
6.00 9
6.25 17
6.50 14
6.75 7
7.00 5
NA 9 
llll <- ggplot(data = data, mapping = aes(x = aes_T3, fill = factor(aes_T3))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(llll) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#aes_T4の度数分布とヒストグラム
aes_T4_count <- dplyr::count(data, aes_T4)
knitr::kable(aes_T4_count) #テーブル化
aes_T4 n
2.75 2
3.50 1
4.25 2
4.50 2
4.75 4
5.00 5
5.25 10
5.50 12
5.75 10
6.00 16
6.25 13
6.50 12
6.75 14
7.00 1
NA 10 
mmmm <- ggplot(data = data, mapping = aes(x = aes_T4, fill = factor(aes_T4))) + geom_histogram(binwidth = 1) #視覚化
ggplotly(mmmm) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc_T1の度数分布とヒストグラム
hsc_T1_count <- dplyr::count(data, hsc_T1)
knitr::kable(hsc_T1_count) #テーブル化
hsc_T1 n
3.183333 1
3.300000 1
3.383333 1
3.400000 1
3.416667 1
3.650000 1
3.766667 1
3.933333 1
3.966667 1
3.983333 1
4.016667 1
4.066667 1
4.116667 1
4.150000 1
4.183333 1
4.266667 1
4.283333 1
4.316667 1
4.350000 2
4.383333 1
4.433333 1
4.450000 1
4.483333 3
4.500000 2
4.516667 1
4.633333 1
4.650000 1
4.683333 1
4.733333 1
4.750000 2
4.766667 2
4.800000 1
4.816667 1
4.850000 5
4.866667 1
4.883333 1
4.916667 1
4.933333 1
5.000000 2
5.016667 1
5.050000 1
5.066667 1
5.116667 1
5.150000 1
5.166667 2
5.200000 1
5.216667 2
5.233333 1
5.250000 1
5.283333 2
5.300000 1
5.316667 3
5.333333 2
5.366667 1
5.383333 1
5.416667 1
5.433333 2
5.450000 1
5.466667 1
5.483333 3
5.500000 1
5.516667 2
5.533333 1
5.566667 3
5.583333 1
5.616667 3
5.666667 1
5.683333 1
5.700000 1
5.733333 2
5.766667 1
5.800000 4
5.833333 1
5.850000 1
5.900000 1
5.916667 1
6.066667 1
6.083333 1
6.116667 1
6.133333 1
6.300000 1
6.383333 1
6.466667 1
6.600000 1
NA 1 
nnnn <- ggplot(data = data, mapping = aes(x = hsc_T1, fill = factor(hsc_T1))) + geom_histogram(binwidth = 0.1) #視覚化
ggplotly(nnnn) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc_T2の度数分布とヒストグラム
hsc_T2_count <- dplyr::count(data, hsc_T2)
knitr::kable(hsc_T2_count) #テーブル化
hsc_T2 n
2.533333 1
2.916667 1
3.066667 1
3.600000 1
3.616667 1
3.716667 1
3.850000 1
4.000000 1
4.016667 1
4.033333 1
4.050000 1
4.100000 2
4.166667 2
4.233333 1
4.316667 1
4.400000 1
4.433333 1
4.466667 1
4.500000 1
4.516667 3
4.533333 1
4.550000 2
4.566667 1
4.633333 1
4.650000 1
4.733333 2
4.766667 1
4.783333 2
4.866667 1
4.883333 2
4.900000 1
4.933333 2
4.950000 1
4.983333 1
5.000000 1
5.016667 1
5.066667 1
5.100000 1
5.116667 1
5.150000 2
5.183333 2
5.200000 2
5.233333 2
5.250000 1
5.283333 1
5.300000 1
5.333333 1
5.350000 1
5.383333 1
5.416667 2
5.433333 2
5.450000 1
5.466667 1
5.516667 1
5.533333 1
5.616667 2
5.633333 1
5.666667 2
5.683333 3
5.700000 3
5.766667 1
5.783333 1
5.800000 1
5.816667 1
5.866667 1
5.883333 1
5.950000 1
6.016667 2
6.066667 2
6.150000 1
6.233333 2
6.283333 1
6.683333 1
6.800000 1
NA 16 
oooo <- ggplot(data = data, mapping = aes(x = hsc_T2, fill = factor(hsc_T2))) + geom_histogram(binwidth = 0.1) #視覚化
ggplotly(oooo) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc_T3の度数分布とヒストグラム
hsc_T3_count <- dplyr::count(data, hsc_T3)
knitr::kable(hsc_T3_count) #テーブル化
hsc_T3 n
3.383333 1
3.483333 1
3.500000 1
3.766667 1
3.916667 1
3.950000 1
4.000000 1
4.016667 1
4.083333 1
4.150000 1
4.216667 1
4.283333 1
4.400000 1
4.433333 1
4.450000 1
4.483333 1
4.533333 1
4.566667 2
4.700000 2
4.766667 2
4.800000 1
4.866667 2
4.883333 1
4.916667 2
4.933333 1
4.950000 1
4.966667 2
4.983333 2
5.000000 1
5.033333 2
5.050000 1
5.100000 2
5.116667 1
5.133333 4
5.166667 2
5.183333 1
5.233333 1
5.250000 1
5.300000 1
5.316667 1
5.333333 2
5.400000 2
5.416667 4
5.433333 1
5.483333 2
5.500000 1
5.516667 1
5.533333 1
5.550000 1
5.583333 1
5.616667 1
5.633333 1
5.666667 1
5.683333 2
5.700000 1
5.716667 1
5.733333 2
5.800000 2
5.816667 1
5.883333 1
5.950000 1
5.983333 1
6.000000 1
6.016667 1
6.033333 1
6.050000 1
6.083333 1
6.100000 1
6.116667 1
6.133333 2
6.150000 1
6.166667 1
6.216667 1
6.333333 1
6.366667 1
6.383333 1
6.450000 2
6.566667 1
6.800000 1
6.916667 1
NA 10 
pppp <- ggplot(data = data, mapping = aes(x = hsc_T3, fill = factor(hsc_T3))) + geom_histogram(binwidth = 0.1) #視覚化
ggplotly(pppp) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc_T4の度数分布とヒストグラム
hsc_T4_count <- dplyr::count(data, hsc_T4)
knitr::kable(hsc_T4_count) #テーブル化
hsc_T4 n
2.616667 1
3.083333 1
3.183333 1
3.583333 1
3.633333 1
3.833333 1
3.850000 1
3.916667 1
3.933333 2
4.066667 1
4.233333 2
4.250000 1
4.333333 2
4.350000 1
4.366667 1
4.516667 1
4.533333 1
4.616667 3
4.633333 2
4.650000 1
4.666667 1
4.716667 1
4.750000 1
4.766667 1
4.783333 3
4.800000 1
4.833333 2
4.850000 1
4.866667 2
4.883333 1
4.900000 1
4.916667 1
4.933333 1
4.950000 1
5.000000 1
5.033333 1
5.100000 1
5.116667 2
5.150000 1
5.166667 1
5.200000 1
5.250000 1
5.300000 2
5.316667 2
5.333333 1
5.350000 1
5.366667 1
5.383333 1
5.400000 1
5.416667 1
5.433333 1
5.466667 1
5.483333 1
5.533333 2
5.550000 2
5.566667 1
5.633333 1
5.683333 2
5.700000 1
5.716667 1
5.733333 1
5.750000 2
5.766667 3
5.783333 2
5.816667 1
5.850000 1
5.866667 1
5.883333 1
5.900000 2
5.966667 1
5.983333 1
6.050000 1
6.116667 1
6.183333 1
6.250000 2
6.283333 1
6.416667 1
6.433333 1
6.450000 1
6.483333 1
6.550000 1
7.000000 1
NA 10 
qqqq <- ggplot(data = data, mapping = aes(x = hsc_T4, fill = factor(hsc_T4))) + geom_histogram(binwidth = 0.1) #視覚化
ggplotly(qqqq) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#wb_T1の度数分布とヒストグラム
wb_T1_count <- dplyr::count(data, wb_T1)
knitr::kable(wb_T1_count) #テーブル化
wb_T1 n
0.6 1
0.8 1
1.2 1
1.4 5
1.6 5
1.8 6
2.0 7
2.2 11
2.4 5
2.6 11
2.8 11
3.0 14
3.2 7
3.4 7
3.6 7
3.8 5
4.0 3
4.2 3
4.4 1
4.6 1
5.0 1
NA 1 
rrrr <- ggplot(data = data, mapping = aes(x = wb_T1, fill = factor(wb_T1))) + geom_histogram(binwidth = 0.5) #視覚化
ggplotly(rrrr) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#wb_T2の度数分布とヒストグラム
wb_T2_count <- dplyr::count(data, wb_T2)
knitr::kable(wb_T2_count) #テーブル化
wb_T2 n
1.0 1
1.2 1
1.4 1
1.6 5
1.8 6
2.0 4
2.2 7
2.4 7
2.6 8
2.8 2
3.0 15
3.2 10
3.4 7
3.6 2
3.8 7
4.0 4
4.2 2
4.4 5
4.6 2
5.0 3
NA 15 
ssss <- ggplot(data = data, mapping = aes(x = wb_T2, fill = factor(wb_T2))) + geom_histogram(binwidth = 0.5) #視覚化
ggplotly(ssss) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#wb_T3の度数分布とヒストグラム
wb_T3_count <- dplyr::count(data, wb_T3)
knitr::kable(wb_T3_count) #テーブル化
wb_T3 n
0.0 1
0.8 1
1.0 2
1.4 3
1.6 1
1.8 5
2.0 5
2.2 8
2.4 10
2.6 7
2.8 10
3.0 12
3.2 8
3.4 5
3.6 4
3.8 10
4.0 5
4.4 1
4.6 3
4.8 1
5.0 3
NA 9 
tttt <- ggplot(data = data, mapping = aes(x = wb_T3, fill = factor(wb_T3))) + geom_histogram(binwidth = 0.5) #視覚化
ggplotly(tttt) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#wb_T4の度数分布とヒストグラム
wb_T4_count <- dplyr::count(data, wb_T4)
knitr::kable(wb_T4_count) #テーブル化
wb_T4 n
0.2 1
0.6 1
0.8 2
1.0 2
1.2 3
1.4 1
1.6 2
1.8 4
2.0 8
2.2 8
2.4 6
2.6 13
2.8 8
3.0 3
3.2 10
3.4 7
3.6 4
3.8 3
4.0 5
4.2 5
4.4 2
4.6 2
5.0 6
NA 8 
uuuu <- ggplot(data = data, mapping = aes(x = wb_T4, fill = factor(wb_T4))) + geom_histogram(binwidth = 0.5) #視覚化
ggplotly(uuuu) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#ev_T1の度数分布とヒストグラム
ev_T1_count <- dplyr::count(data, ev_T1)
knitr::kable(ev_T1_count) #テーブル化
ev_T1 n
-3.0 3
-2.5 1
-2.0 1
-1.5 7
-1.0 4
-0.5 9
0.0 21
0.5 18
1.0 11
1.5 1
2.0 3
2.5 15
3.0 19
NA 1 
vvvv <- ggplot(data = data, mapping = aes(x = ev_T1, fill = factor(ev_T1))) + geom_histogram(binwidth = 0.5) #視覚化
ggplotly(vvvv) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#ev_T2の度数分布とヒストグラム
ev_T2_count <- dplyr::count(data, ev_T2)
knitr::kable(ev_T2_count) #テーブル化
ev_T2 n
-3.0 3
-2.5 5
-2.0 1
-1.5 3
-1.0 4
-0.5 3
0.0 22
0.5 10
1.0 9
1.5 3
2.0 6
2.5 12
3.0 14
NA 19 
wwww <- ggplot(data = data, mapping = aes(x = ev_T2, fill = factor(ev_T2))) + geom_histogram(binwidth = 0.5) #視覚化
ggplotly(wwww) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#ev_T3の度数分布とヒストグラム
ev_T3_count <- dplyr::count(data, ev_T3)
knitr::kable(ev_T3_count) #テーブル化
ev_T3 n
-3.0 7
-2.0 3
-1.5 1
-1.0 3
-0.5 8
0.0 20
0.5 17
1.0 8
1.5 6
2.0 10
2.5 5
3.0 15
NA 11 
panda <- ggplot(data = data, mapping = aes(x = ev_T3, fill = factor(ev_T3))) + geom_histogram(binwidth = 0.5) #視覚化
ggplotly(panda) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#ev_T4の度数分布とヒストグラム
ev_T4_count <- dplyr::count(data, ev_T4)
knitr::kable(ev_T4_count) #テーブル化
ev_T4 n
-3.0 3
-2.0 1
-1.0 3
-0.5 10
0.0 21
0.5 15
1.0 9
1.5 8
2.0 10
2.5 7
3.0 14
NA 13 
yyyy <- ggplot(data = data, mapping = aes(x = ev_T4, fill = factor(ev_T4))) + geom_histogram(binwidth = 0.5) #視覚化
ggplotly(yyyy) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#hsc_onemonthの度数分布とヒストグラム
hsc_onemonth_count <- dplyr::count(data, hsc_onemonth)
knitr::kable(hsc_onemonth_count) #テーブル化
hsc_onemonth n
3.170833 1
3.533333 1
3.750000 1
3.887500 1
4.033333 1
4.100000 1
4.145833 1
4.262500 1
4.270833 1
4.279167 1
4.437500 1
4.441667 1
4.475000 1
4.504167 1
4.575000 2
4.600000 1
4.604167 1
4.645833 1
4.679167 1
4.750000 1
4.754167 1
4.762500 1
4.775000 1
4.804167 1
4.837500 1
4.883333 1
4.904167 1
4.912500 1
4.962500 1
4.966667 1
4.975000 1
5.008333 1
5.016667 1
5.037500 1
5.041667 1
5.058333 1
5.066667 1
5.079167 1
5.079167 1
5.116667 1
5.175000 1
5.200000 1
5.241667 1
5.270833 1
5.275000 1
5.287500 1
5.304167 2
5.329167 1
5.362500 1
5.383333 1
5.391667 1
5.400000 1
5.404167 1
5.420833 1
5.425000 1
5.533333 1
5.537500 1
5.554167 1
5.591667 1
5.608333 1
5.625000 1
5.637500 2
5.641667 1
5.650000 1
5.729167 1
5.737500 1
5.783333 1
5.795833 1
5.812500 1
5.829167 1
5.875000 1
5.879167 1
5.900000 1
5.987500 1
6.012500 1
6.029167 1
6.054167 1
6.095833 1
6.158333 1
6.237500 1
6.258333 1
6.570833 1
6.687500 1
NA 28 
zzzz <- ggplot(data = data, mapping = aes(x = hsc_onemonth, fill = factor(hsc_onemonth))) + geom_histogram(binwidth = 0.3) + guides(fill = "none") #視覚化
ggplotly(zzzz) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#wb_onemonthの度数分布とヒストグラム
wb_onemonth_count <- dplyr::count(data, wb_onemonth)
knitr::kable(wb_onemonth_count) #テーブル化
wb_onemonth n
1.15 1
1.25 1
1.30 1
1.40 1
1.65 1
1.75 1
1.80 1
1.85 1
1.95 1
2.00 1
2.00 1
2.10 2
2.15 1
2.20 1
2.25 2
2.30 1
2.30 1
2.35 1
2.40 3
2.45 1
2.45 2
2.50 3
2.55 1
2.60 1
2.70 1
2.75 1
2.75 1
2.80 4
2.80 1
2.85 4
2.85 2
2.85 2
2.90 1
2.90 1
2.95 2
2.95 3
3.05 4
3.05 1
3.15 1
3.20 1
3.30 1
3.35 2
3.40 1
3.45 1
3.45 1
3.50 1
3.55 1
3.60 2
3.60 1
3.65 1
3.75 1
3.80 1
3.80 1
3.85 1
4.05 1
4.10 1
4.20 2
4.25 2
4.40 1
4.45 2
4.55 1
4.85 1
NA 26 
A <- ggplot(data = data, mapping = aes(x = wb_onemonth, fill = factor(wb_onemonth))) + geom_histogram(binwidth = 0.3) + guides(fill = "none") #視覚化
ggplotly(A) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`
#ev_onemonthの度数分布とヒストグラム
ev_onemonth_count <- dplyr::count(data, ev_onemonth)
knitr::kable(ev_onemonth_count) #テーブル化
ev_onemonth n
-1.625 1
-1.125 1
-0.875 1
-0.750 2
-0.625 1
-0.500 1
-0.375 1
-0.250 3
-0.125 2
0.000 4
0.125 6
0.250 7
0.375 2
0.500 4
0.625 2
0.750 6
0.875 3
1.000 2
1.125 2
1.250 3
1.375 5
1.500 5
1.625 3
1.750 4
1.875 3
2.125 2
2.250 2
2.500 1
2.625 2
2.750 1
2.875 2
NA 30 
B <- ggplot(data = data, mapping = aes(x = ev_onemonth, fill = factor(ev_onemonth))) + geom_histogram(binwidth = 0.3) + guides(fill = "none") #視覚化
ggplotly(B) #視覚化
## We recommend that you use the dev version of ggplot2 with `ggplotly()`
## Install it with: `devtools::install_github('hadley/ggplot2')`

1-4. 記述統計量

#hsc_T1
hsc_T1_discriptive <- 
  data %>%
  drop_na() %>%
  dplyr::summarise(n = n (), #グループの人数を出力
                   hsc1.T1.mean = mean (hsc1_T1), #hsc1_T1の平均
                   hsc1.T1.sd = sd (hsc1_T1), #hsc1_T1のSD
                   hsc2.T1.mean = mean (hsc2_T1), 
                   hsc2.T1.sd = sd (hsc2_T1),
                   hsc3.T1.mean = mean (hsc3_T1), 
                   hsc3.T1.sd = sd (hsc3_T1),
                   hsc4.T1.mean = mean (hsc4_T1), 
                   hsc4.T1.sd = sd (hsc4_T1),
                   hsc5.T1.mean = mean (hsc5_T1), 
                   hsc5.T1.sd = sd (hsc5_T1),
                   hsc6.T1.mean = mean (hsc6_T1), 
                   hsc6.T1.sd = sd (hsc6_T1),
                   hsc7.T1.mean = mean (hsc7_T1), 
                   hsc7.T1.sd = sd (hsc7_T1),
                   hsc8.T1.mean = mean (hsc8_T1), 
                   hsc8.T1.sd = sd (hsc8_T1),
                   hsc9.T1.mean = mean (hsc9_T1), 
                   hsc9.T1.sd = sd (hsc9_T1),
                   hsc10.T1.mean = mean (hsc10_T1), 
                   hsc10.T1.sd = sd (hsc10_T1),
                   hsc11.T1.mean = mean (hsc11_T1), 
                   hsc11.T1.sd = sd (hsc11_T1),
                   hsc12.T1.mean = mean (hsc4_T1), 
                   hsc12.T1.sd = sd (hsc4_T1),
                   eoe.mean.T1 = mean (eoe_T1),
                   eoe.sd.T1 = sd (eoe_T1),
                   lst.mean.T1 = mean (lst_T1),
                   lst.sd.T1 = sd (lst_T1),
                   aes.mean.T1 = mean (aes_T1),
                   aes.sd.T1 = sd (aes_T1),
                   hsc.mean.T1 = mean (hsc_T1),
                   hsc.sd.T1 = sd (hsc_T1))
knitr::kable(hsc_T1_discriptive, digits = 2) #出力
n hsc1.T1.mean hsc1.T1.sd hsc2.T1.mean hsc2.T1.sd hsc3.T1.mean hsc3.T1.sd hsc4.T1.mean hsc4.T1.sd hsc5.T1.mean hsc5.T1.sd hsc6.T1.mean hsc6.T1.sd hsc7.T1.mean hsc7.T1.sd hsc8.T1.mean hsc8.T1.sd hsc9.T1.mean hsc9.T1.sd hsc10.T1.mean hsc10.T1.sd hsc11.T1.mean hsc11.T1.sd hsc12.T1.mean hsc12.T1.sd eoe.mean.T1 eoe.sd.T1 lst.mean.T1 lst.sd.T1 aes.mean.T1 aes.sd.T1 hsc.mean.T1 hsc.sd.T1
79 4.68 1.38 4.75 1.55 5.7 1.22 4.52 1.7 6.25 0.85 4.95 1.35 4.68 1.82 4.15 1.46 3.59 1.42 6.52 0.78 4.97 1.52 4.52 1.7 4.58 0.95 4.86 1.39 5.79 0.6 5.08 0.73 
#hsc_T2
hsc_T2_discriptive <- 
  data %>%
  drop_na() %>%
  dplyr::summarise(n = n (), #グループの人数を出力
                   hsc1.T2.mean = mean (hsc1_T2), #hsc1_T2の平均
                   hsc1.T2.sd = sd (hsc1_T2), #hsc1_T2のSD
                   hsc2.T2.mean = mean (hsc2_T2), 
                   hsc2.T2.sd = sd (hsc2_T2),
                   hsc3.T2.mean = mean (hsc3_T2), 
                   hsc3.T2.sd = sd (hsc3_T2),
                   hsc4.T2.mean = mean (hsc4_T2), 
                   hsc4.T2.sd = sd (hsc4_T2),
                   hsc5.T2.mean = mean (hsc5_T2), 
                   hsc5.T2.sd = sd (hsc5_T2),
                   hsc6.T2.mean = mean (hsc6_T2), 
                   hsc6.T2.sd = sd (hsc6_T2),
                   hsc7.T2.mean = mean (hsc7_T2), 
                   hsc7.T2.sd = sd (hsc7_T2),
                   hsc8.T2.mean = mean (hsc8_T2), 
                   hsc8.T2.sd = sd (hsc8_T2),
                   hsc9.T2.mean = mean (hsc9_T2), 
                   hsc9.T2.sd = sd (hsc9_T2),
                   hsc10.T2.mean = mean (hsc10_T2), 
                   hsc10.T2.sd = sd (hsc10_T2),
                   hsc11.T2.mean = mean (hsc11_T2), 
                   hsc11.T2.sd = sd (hsc11_T2),
                   hsc12.T2.mean = mean (hsc4_T2), 
                   hsc12.T2.sd = sd (hsc4_T2),
                   eoe.mean.T2 = mean (eoe_T2),
                   eoe.sd.T2 = sd (eoe_T2),
                   lst.mean.T2 = mean (lst_T2),
                   lst.sd.T2 = sd (lst_T2),
                   aes.mean.T2 = mean (aes_T2),
                   aes.sd.T2 = sd (aes_T2),
                   hsc.mean.T2 = mean (hsc_T2),
                   hsc.sd.T2 = sd (hsc_T2)) 
knitr::kable(hsc_T2_discriptive, digits = 2) #出力
n hsc1.T2.mean hsc1.T2.sd hsc2.T2.mean hsc2.T2.sd hsc3.T2.mean hsc3.T2.sd hsc4.T2.mean hsc4.T2.sd hsc5.T2.mean hsc5.T2.sd hsc6.T2.mean hsc6.T2.sd hsc7.T2.mean hsc7.T2.sd hsc8.T2.mean hsc8.T2.sd hsc9.T2.mean hsc9.T2.sd hsc10.T2.mean hsc10.T2.sd hsc11.T2.mean hsc11.T2.sd hsc12.T2.mean hsc12.T2.sd eoe.mean.T2 eoe.sd.T2 lst.mean.T2 lst.sd.T2 aes.mean.T2 aes.sd.T2 hsc.mean.T2 hsc.sd.T2
79 4.73 1.17 4.92 1.44 5.73 1.17 4.71 1.63 6.18 0.98 5.06 1.24 4.81 1.71 4.46 1.29 3.8 1.4 6.42 0.93 4.92 1.53 4.71 1.63 4.75 0.94 4.92 1.39 5.77 0.65 5.15 0.76 
#hsc_T3
hsc_T3_discriptive <- 
  data %>%
  drop_na() %>%
  dplyr::summarise(n = n (), #グループの人数を出力
                   hsc1.T3.mean = mean (hsc1_T3), #hsc1_T3の平均
                   hsc1.T3.sd = sd (hsc1_T3), #hsc1_T3のSD
                   hsc2.T3.mean = mean (hsc2_T3), 
                   hsc2.T3.sd = sd (hsc2_T3),
                   hsc3.T3.mean = mean (hsc3_T3), 
                   hsc3.T3.sd = sd (hsc3_T3),
                   hsc4.T3.mean = mean (hsc4_T3), 
                   hsc4.T3.sd = sd (hsc4_T3),
                   hsc5.T3.mean = mean (hsc5_T3), 
                   hsc5.T3.sd = sd (hsc5_T3),
                   hsc6.T3.mean = mean (hsc6_T3), 
                   hsc6.T3.sd = sd (hsc6_T3),
                   hsc7.T3.mean = mean (hsc7_T3), 
                   hsc7.T3.sd = sd (hsc7_T3),
                   hsc8.T3.mean = mean (hsc8_T3), 
                   hsc8.T3.sd = sd (hsc8_T3),
                   hsc9.T3.mean = mean (hsc9_T3), 
                   hsc9.T3.sd = sd (hsc9_T3),
                   hsc10.T3.mean = mean (hsc10_T3), 
                   hsc10.T3.sd = sd (hsc10_T3),
                   hsc11.T3.mean = mean (hsc11_T3), 
                   hsc11.T3.sd = sd (hsc11_T3),
                   hsc12.T3.mean = mean (hsc4_T3), 
                   hsc12.T3.sd = sd (hsc4_T3),
                   eoe.mean.T3 = mean (eoe_T3),
                   eoe.sd.T3 = sd (eoe_T3),
                   lst.mean.T3 = mean (lst_T3),
                   lst.sd.T3 = sd (lst_T3),
                   aes.mean.T3 = mean (aes_T3),
                   aes.sd.T3 = sd (aes_T3),
                   hsc.mean.T3 = mean (hsc_T3),
                   hsc.sd.T3 = sd (hsc_T3)) 
knitr::kable(hsc_T3_discriptive, digits = 2) #出力
n hsc1.T3.mean hsc1.T3.sd hsc2.T3.mean hsc2.T3.sd hsc3.T3.mean hsc3.T3.sd hsc4.T3.mean hsc4.T3.sd hsc5.T3.mean hsc5.T3.sd hsc6.T3.mean hsc6.T3.sd hsc7.T3.mean hsc7.T3.sd hsc8.T3.mean hsc8.T3.sd hsc9.T3.mean hsc9.T3.sd hsc10.T3.mean hsc10.T3.sd hsc11.T3.mean hsc11.T3.sd hsc12.T3.mean hsc12.T3.sd eoe.mean.T3 eoe.sd.T3 lst.mean.T3 lst.sd.T3 aes.mean.T3 aes.sd.T3 hsc.mean.T3 hsc.sd.T3
79 4.78 1.17 5.08 1.54 6.06 1.1 4.97 1.49 6.32 1.01 5.32 1.39 4.63 1.88 4.67 1.49 3.87 1.5 6.57 0.69 4.86 1.55 4.97 1.49 4.91 1.01 4.97 1.43 5.93 0.61 5.27 0.77 
#hsc_T4
hsc_T4_discriptive <- 
  data %>%
  drop_na() %>%
  dplyr::summarise(n = n (), #グループの人数を出力
                   hsc1.T4.mean = mean (hsc1_T4), #hsc1_T4の平均
                   hsc1.T4.sd = sd (hsc1_T4), #hsc1_T4のSD
                   hsc2.T4.mean = mean (hsc2_T4), 
                   hsc2.T4.sd = sd (hsc2_T4),
                   hsc3.T4.mean = mean (hsc3_T4), 
                   hsc3.T4.sd = sd (hsc3_T4),
                   hsc4.T4.mean = mean (hsc4_T4), 
                   hsc4.T4.sd = sd (hsc4_T4),
                   hsc5.T4.mean = mean (hsc5_T4), 
                   hsc5.T4.sd = sd (hsc5_T4),
                   hsc6.T4.mean = mean (hsc6_T4), 
                   hsc6.T4.sd = sd (hsc6_T4),
                   hsc7.T4.mean = mean (hsc7_T4), 
                   hsc7.T4.sd = sd (hsc7_T4),
                   hsc8.T4.mean = mean (hsc8_T4), 
                   hsc8.T4.sd = sd (hsc8_T4),
                   hsc9.T4.mean = mean (hsc9_T4), 
                   hsc9.T4.sd = sd (hsc9_T4),
                   hsc10.T4.mean = mean (hsc10_T4), 
                   hsc10.T4.sd = sd (hsc10_T4),
                   hsc11.T4.mean = mean (hsc11_T4), 
                   hsc11.T4.sd = sd (hsc11_T4),
                   hsc12.T4.mean = mean (hsc4_T4), 
                   hsc12.T4.sd = sd (hsc4_T4),
                   eoe.mean.T4 = mean (eoe_T4),
                   eoe.sd.T4 = sd (eoe_T4),
                   lst.mean.T4 = mean (lst_T4),
                   lst.sd.T4 = sd (lst_T4),
                   aes.mean.T4 = mean (aes_T4),
                   aes.sd.T4 = sd (aes_T4),
                   hsc.mean.T4 = mean (hsc_T4),
                   hsc.sd.T4 = sd (hsc_T4)) 
knitr::kable(hsc_T4_discriptive, digits = 2) #出力
n hsc1.T4.mean hsc1.T4.sd hsc2.T4.mean hsc2.T4.sd hsc3.T4.mean hsc3.T4.sd hsc4.T4.mean hsc4.T4.sd hsc5.T4.mean hsc5.T4.sd hsc6.T4.mean hsc6.T4.sd hsc7.T4.mean hsc7.T4.sd hsc8.T4.mean hsc8.T4.sd hsc9.T4.mean hsc9.T4.sd hsc10.T4.mean hsc10.T4.sd hsc11.T4.mean hsc11.T4.sd hsc12.T4.mean hsc12.T4.sd eoe.mean.T4 eoe.sd.T4 lst.mean.T4 lst.sd.T4 aes.mean.T4 aes.sd.T4 hsc.mean.T4 hsc.sd.T4
79 4.82 1.15 5.05 1.5 6.11 1.07 4.86 1.65 6.24 1.06 5.09 1.37 4.8 1.86 4.71 1.43 3.92 1.48 6.59 0.69 4.82 1.63 4.86 1.65 4.85 1.11 4.94 1.45 5.94 0.67 5.24 0.78 
#hsc_onemonth
hsc_onemonth_discriptive <- 
  data %>%
  drop_na() %>%
  dplyr::summarise(n = n (), #グループの人数を出力
                   hsc1.onemonth.mean = mean (hsc_onemonth), #hsc_onemonthの平均
                   hsc1.onemonth.sd = sd (hsc_onemonth)) #hsc_onemonthのSD
knitr::kable(hsc_onemonth_discriptive, digits = 2) #出力
n hsc1.onemonth.mean hsc1.onemonth.sd
79 5.18 0.68 
#wb_T1
wb_T1_discriptive <- 
  data %>%
  drop_na() %>%
  dplyr::summarise(n = n (), #グループの人数を出力
                   wb1.T1.mean = mean (wb1_T1), #hsc1_T10の平均
                   wb1.T1.sd = sd (wb1_T1), #hsc1_T10のSD
                   wb2.T1.mean = mean (wb2_T1), 
                   wb2.T1.sd = sd (wb2_T1),
                   wb3.T1.mean = mean (wb3_T1), 
                   wb3.T1.sd = sd (wb3_T1),
                   wb4.T1.mean = mean (wb4_T1), 
                   wb4.T1.sd = sd (wb4_T1),
                   wb5.T1.mean = mean (wb5_T1), 
                   wb5.T1.sd = sd (wb5_T1),
                   wb.T1.mean = mean (wb_T1),
                   wb.T1.sd = sd (wb_T1))
knitr::kable(wb_T1_discriptive, digits = 2) #出力
n wb1.T1.mean wb1.T1.sd wb2.T1.mean wb2.T1.sd wb3.T1.mean wb3.T1.sd wb4.T1.mean wb4.T1.sd wb5.T1.mean wb5.T1.sd wb.T1.mean wb.T1.sd
79 3.22 1 2.87 1.14 3.04 1.11 2.23 1.17 2.86 1.14 2.84 0.8 
#wb_T2
wb_T2_discriptive <- 
  data %>%
  drop_na() %>%
  dplyr::summarise(n = n (), #グループの人数を出力
                   wb1.T2.mean = mean (wb1_T2), #hsc1_T2の平均
                   wb1.T2.sd = sd (wb1_T2), #hsc1_T2のSD
                   wb2.T2.mean = mean (wb2_T2), 
                   wb2.T2.sd = sd (wb2_T2),
                   wb3.T2.mean = mean (wb3_T2), 
                   wb3.T2.sd = sd (wb3_T2),
                   wb4.T2.mean = mean (wb4_T2), 
                   wb4.T2.sd = sd (wb4_T2),
                   wb5.T2.mean = mean (wb5_T2), 
                   wb5.T2.sd = sd (wb5_T2),
                   wb.T2.mean = mean (wb_T2),
                   wb.T2.sd = sd (wb_T2))
knitr::kable(wb_T2_discriptive, digits = 2) #出力
n wb1.T2.mean wb1.T2.sd wb2.T2.mean wb2.T2.sd wb3.T2.mean wb3.T2.sd wb4.T2.mean wb4.T2.sd wb5.T2.mean wb5.T2.sd wb.T2.mean wb.T2.sd
79 3.22 1 3.13 1.11 3.15 1.17 2.38 1.29 2.94 1.24 2.96 0.93 
#wb_T3
wb_T3_discriptive <- 
  data %>%
  drop_na() %>%
  dplyr::summarise(n = n (), #グループの人数を出力
                   wb1.T3.mean = mean (wb1_T3), #hsc1_T3の平均
                   wb1.T3.sd = sd (wb1_T3), #hsc1_T3のSD
                   wb2.T3.mean = mean (wb2_T3), 
                   wb2.T3.sd = sd (wb2_T3),
                   wb3.T3.mean = mean (wb3_T3), 
                   wb3.T3.sd = sd (wb3_T3),
                   wb4.T3.mean = mean (wb4_T3), 
                   wb4.T3.sd = sd (wb4_T3),
                   wb5.T3.mean = mean (wb5_T3), 
                   wb5.T3.sd = sd (wb5_T3),
                   wb.T3.mean = mean (wb_T3),
                   wb.T3.sd = sd (wb_T3))
knitr::kable(wb_T3_discriptive, digits = 2) #出力
n wb1.T3.mean wb1.T3.sd wb2.T3.mean wb2.T3.sd wb3.T3.mean wb3.T3.sd wb4.T3.mean wb4.T3.sd wb5.T3.mean wb5.T3.sd wb.T3.mean wb.T3.sd
79 3.35 1.16 3.04 1.24 3.28 1.12 2.32 1.25 2.68 1.16 2.93 0.92 
#wb_T4
wb_T4_discriptive <- 
  data %>%
  drop_na() %>%
  dplyr::summarise(n = n (), #グループの人数を出力
                   wb1.T4.mean = mean (wb1_T4), #hsc1_T4の平均
                   wb1.T4.sd = sd (wb1_T4), #hsc1_T4のSD
                   wb2.T4.mean = mean (wb2_T4), 
                   wb2.T4.sd = sd (wb2_T4),
                   wb3.T4.mean = mean (wb3_T4), 
                   wb3.T4.sd = sd (wb3_T4),
                   wb4.T4.mean = mean (wb4_T4), 
                   wb4.T4.sd = sd (wb4_T4),
                   wb5.T4.mean = mean (wb5_T4), 
                   wb5.T4.sd = sd (wb5_T4),
                   wb.T4.mean = mean (wb_T4),
                   wb.T4.sd = sd (wb_T4))
knitr::kable(wb_T4_discriptive, digits = 2) #出力
n wb1.T4.mean wb1.T4.sd wb2.T4.mean wb2.T4.sd wb3.T4.mean wb3.T4.sd wb4.T4.mean wb4.T4.sd wb5.T4.mean wb5.T4.sd wb.T4.mean wb.T4.sd
79 3.18 1.11 2.91 1.21 3.15 1.22 2.33 1.32 2.89 1.37 2.89 1.03 
#wb_onemonth
wb_onemonth_discriptive <- 
  data %>%
  drop_na() %>%
  dplyr::summarise(n = n (), #グループの人数を出力
                   wb.onemonth.mean = mean (wb_onemonth), #wb_onemonthの平均
                   wb.onemonth.sd = sd (wb_onemonth)) #wb_onemonthのSD
knitr::kable(wb_onemonth_discriptive, digits = 2) #出力
n wb.onemonth.mean wb.onemonth.sd
79 2.91 0.81 
#ev_T1
ev_T1_discriptive <- 
  data %>%
  drop_na() %>%
  dplyr::summarise(n = n (), #グループの人数を出力
                   ev1.T1.mean = mean (ev1_T1), #ev1_T1の平均
                   ev1.T1.sd = sd (ev1_T1), #ev1_T1のSD
                   ev2.T1.mean = mean (ev2_T1), 
                   ev2.T1.sd = sd (ev2_T1),
                   ev.T1.mean = mean (ev_T1),
                   ev.T1.sd = sd (ev_T1))
knitr::kable(ev_T1_discriptive, digits = 2) #出力
n ev1.T1.mean ev1.T1.sd ev2.T1.mean ev2.T1.sd ev.T1.mean ev.T1.sd
79 1.03 2.36 1.03 2.42 1.03 1.6 
#ev_T2
ev_T2_discriptive <- 
  data %>%
  drop_na() %>%
  dplyr::summarise(n = n (), #グループの人数を出力
                   ev1.T2.mean = mean (ev1_T2), #ev1_T2の平均
                   ev1.T2.sd = sd (ev1_T2), #ev1_T2のSD
                   ev2.T2.mean = mean (ev2_T2), 
                   ev2.T2.sd = sd (ev2_T2),
                   ev.T2.mean = mean (ev_T2),
                   ev.T2.sd = sd (ev_T2))
knitr::kable(ev_T2_discriptive, digits = 2) #出力
n ev1.T2.mean ev1.T2.sd ev2.T2.mean ev2.T2.sd ev.T2.mean ev.T2.sd
79 1.29 2.27 0.2 2.48 0.75 1.62 
#ev_T3
ev_T3_discriptive <- 
  data %>%
  drop_na() %>%
  dplyr::summarise(n = n (), #グループの人数を出力
                   ev1.T3.mean = mean (ev_T3), #ev1_T3の平均
                   ev1.T3.sd = sd (ev1_T3), #ev1_T3のSD
                   ev2.T3.mean = mean (ev2_T3), 
                   ev2.T3.sd = sd (ev2_T3),
                   ev.T3.mean = mean (ev_T3),
                   ev.T3.sd = sd (ev_T3))
knitr::kable(ev_T3_discriptive, digits = 2) #出力
n ev1.T3.mean ev1.T3.sd ev2.T3.mean ev2.T3.sd ev.T3.mean ev.T3.sd
79 0.73 2.38 0.53 2.43 0.73 1.58 
#ev_T4
ev_T4_discriptive <- 
  data %>%
  drop_na() %>%
  dplyr::summarise(n = n (), #グループの人数を出力
                   ev1.T4.mean = mean (ev1_T4), #ev1_T4の平均
                   ev1.T4.sd = sd (ev1_T4), #ev1_T4のSD
                   ev2.T4.mean = mean (ev2_T4), 
                   ev2.T4.sd = sd (ev2_T4),
                   ev.T4.mean = mean (ev_T4),
                   ev.T4.sd = sd (ev_T4))
knitr::kable(ev_T4_discriptive, digits = 2) #出力
n ev1.T4.mean ev1.T4.sd ev2.T4.mean ev2.T4.sd ev.T4.mean ev.T4.sd
79 1.33 2.27 0.52 2.3 0.92 1.47 
#ev_onemonth
ev_onemonth_discriptive <- 
  data %>%
  drop_na() %>%
  dplyr::summarise(n = n (), #グループの人数を出力
                   ev.onemonth.mean = mean (ev_onemonth), #ev_onemonthの平均
                   ev.onemonth.sd = sd (ev_onemonth)) #ev_onemonthのSD
knitr::kable(ev_onemonth_discriptive, digits = 2) #出力
n ev.onemonth.mean ev.onemonth.sd
79 0.86 0.98 
#age_T1
age_T1_discriptive <- 
  data %>%
  drop_na() %>%
  dplyr::summarise(n = n (), #グループの人数を出力
                   age.T1.mean = mean (age_T1), #age_T1の平均
                   age.T1.sd = sd (age_T1)) #age_T1のSD
knitr::kable(age_T1_discriptive, digits = 2) #出力
n age.T1.mean age.T1.sd
79 18.65 0.77 
#age_T2
age_T2_discriptive <- 
  data %>%
  drop_na() %>%
  dplyr::summarise(n = n (), #グループの人数を出力
                   age.T2.mean = mean (age_T2), #age_T2の平均
                   age.T2.sd = sd (age_T2)) #age_T2のSD
knitr::kable(age_T2_discriptive, digits = 2) #出力
n age.T2.mean age.T2.sd
79 18.65 0.77 
#age_T3
age_T3_discriptive <- 
  data %>%
  drop_na() %>%
  dplyr::summarise(n = n (), #グループの人数を出力
                   age.T3.mean = mean (age_T3), #age_T3の平均
                   age.T3.sd = sd (age_T3)) #age_T3のSD
knitr::kable(age_T3_discriptive, digits = 2) #出力
n age.T3.mean age.T3.sd
79 18.68 0.76 
#age_T4
age_T4_discriptive <- 
  data %>%
  drop_na() %>%
  dplyr::summarise(n = n (), #グループの人数を出力
                   age.T4.mean = mean (age_T4), #age_T4の平均
                   age.T4.sd = sd (age_T4)) #age_T4のSD
knitr::kable(age_T4_discriptive, digits = 2) #出力
n age.T4.mean age.T4.sd
79 18.68 0.76

1-5. 内的整合性

library(psych)
## 
## Attaching package: 'psych'
## The following objects are masked from 'package:ggplot2':
## 
##     %+%, alpha
library(GPArotation)

#hsc_T1
alpha(data[, c(6,7,8,9,11,12,13,14,15,16,17)]) #alpha .63
## 
## Reliability analysis   
## Call: alpha(x = data[, c(6, 7, 8, 9, 11, 12, 13, 14, 15, 16, 17)])
## 
##   raw_alpha std.alpha G6(smc) average_r S/N   ase mean   sd median_r
##       0.64      0.63    0.69      0.14 1.7 0.048  4.9 0.68     0.13
## 
##  lower alpha upper     95% confidence boundaries
## 0.55 0.64 0.74 
## 
##  Reliability if an item is dropped:
##          raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## hsc1_T1       0.66      0.65    0.69      0.16 1.9    0.047 0.024 0.129
## hsc2_T1       0.58      0.57    0.61      0.12 1.3    0.057 0.020 0.094
## hsc3_T1       0.64      0.64    0.69      0.15 1.8    0.048 0.028 0.140
## hsc4_T1       0.59      0.58    0.65      0.12 1.4    0.056 0.027 0.094
## hsc6_T1       0.59      0.58    0.63      0.12 1.4    0.056 0.021 0.105
## hsc7_T1       0.67      0.65    0.70      0.16 1.9    0.044 0.025 0.145
## hsc8_T1       0.56      0.55    0.61      0.11 1.2    0.059 0.019 0.094
## hsc9_T1       0.62      0.62    0.68      0.14 1.6    0.051 0.026 0.129
## hsc10_T1      0.64      0.65    0.69      0.15 1.8    0.049 0.026 0.140
## hsc11_T1      0.59      0.59    0.63      0.12 1.4    0.055 0.022 0.105
## hsc12_T1      0.62      0.61    0.67      0.14 1.6    0.051 0.025 0.105
## 
##  Item statistics 
##            n raw.r std.r r.cor r.drop mean   sd
## hsc1_T1  114  0.27  0.28 0.142  0.087  4.8 1.38
## hsc2_T1  114  0.63  0.63 0.643  0.467  4.7 1.62
## hsc3_T1  113  0.31  0.34 0.193  0.139  5.6 1.31
## hsc4_T1  114  0.60  0.57 0.506  0.416  4.4 1.78
## hsc6_T1  114  0.58  0.59 0.561  0.437  4.9 1.41
## hsc7_T1  114  0.29  0.26 0.095  0.063  4.8 1.74
## hsc8_T1  114  0.70  0.68 0.700  0.581  4.1 1.38
## hsc9_T1  114  0.44  0.43 0.317  0.264  3.6 1.43
## hsc10_T1 114  0.21  0.30 0.152  0.111  6.5 0.77
## hsc11_T1 114  0.58  0.57 0.551  0.410  4.9 1.51
## hsc12_T1 114  0.46  0.46 0.360  0.286  5.6 1.43
## 
## Non missing response frequency for each item
##             1    2    3    4    5    6    7 miss
## hsc1_T1  0.02 0.07 0.09 0.14 0.42 0.17 0.10 0.00
## hsc2_T1  0.03 0.11 0.09 0.18 0.25 0.21 0.14 0.00
## hsc3_T1  0.00 0.04 0.04 0.11 0.20 0.31 0.31 0.01
## hsc4_T1  0.07 0.11 0.11 0.17 0.25 0.15 0.14 0.00
## hsc6_T1  0.02 0.04 0.11 0.18 0.31 0.22 0.12 0.00
## hsc7_T1  0.04 0.10 0.11 0.18 0.15 0.23 0.19 0.00
## hsc8_T1  0.03 0.14 0.11 0.37 0.21 0.11 0.04 0.00
## hsc9_T1  0.08 0.18 0.16 0.33 0.15 0.09 0.01 0.00
## hsc10_T1 0.00 0.00 0.00 0.03 0.09 0.25 0.63 0.00
## hsc11_T1 0.02 0.04 0.11 0.22 0.23 0.20 0.18 0.00
## hsc12_T1 0.02 0.04 0.04 0.02 0.25 0.32 0.31 0.00
omega(data[, c(6,7,8,9,11,12,13,14,15,16,17)],3,fm="ml") #omega hierarchical=.41, omega total=.74

## Omega 
## Call: omega(m = data[, c(6, 7, 8, 9, 11, 12, 13, 14, 15, 16, 17)], 
##     nfactors = 3, fm = "ml")
## Alpha:                 0.63 
## G.6:                   0.69 
## Omega Hierarchical:    0.41 
## Omega H asymptotic:    0.56 
## Omega Total            0.74 
## 
## Schmid Leiman Factor loadings greater than  0.2 
##              g   F1*   F2*   F3*   h2   u2   p2
## hsc1_T1                     0.98 1.00 0.00 0.03
## hsc2_T1   0.66        0.69       0.91 0.09 0.48
## hsc3_T1                          0.06 0.94 0.20
## hsc4_T1   0.30  0.32             0.22 0.78 0.42
## hsc6_T1   0.43  0.45             0.40 0.60 0.47
## hsc7_T1                          0.03 0.97 0.00
## hsc8_T1   0.56  0.67             0.76 0.24 0.41
## hsc9_T1   0.23  0.33             0.17 0.83 0.31
## hsc10_T1              0.25       0.10 0.90 0.09
## hsc11_T1  0.48        0.44       0.46 0.54 0.50
## hsc12_T1  0.23             -0.21 0.15 0.85 0.36
## 
## With eigenvalues of:
##    g  F1*  F2*  F3* 
## 1.41 0.98 0.76 1.09 
## 
## general/max  1.29   max/min =   1.43
## mean percent general =  0.3    with sd =  0.19 and cv of  0.63 
## Explained Common Variance of the general factor =  0.33 
## 
## The degrees of freedom are 25  and the fit is  0.24 
## The number of observations was  114  with Chi Square =  26.06  with prob <  0.4
## The root mean square of the residuals is  0.05 
## The df corrected root mean square of the residuals is  0.07
## RMSEA index =  0.031  and the 10 % confidence intervals are  0 0.079
## BIC =  -92.35
## 
## Compare this with the adequacy of just a general factor and no group factors
## The degrees of freedom for just the general factor are 44  and the fit is  0.99 
## The number of observations was  114  with Chi Square =  106.32  with prob <  4.5e-07
## The root mean square of the residuals is  0.12 
## The df corrected root mean square of the residuals is  0.13 
## 
## RMSEA index =  0.116  and the 10 % confidence intervals are  0.085 0.139
## BIC =  -102.07 
## 
## Measures of factor score adequacy             
##                                                  g  F1*  F2*  F3*
## Correlation of scores with factors            0.75 0.75 0.75 0.99
## Multiple R square of scores with factors      0.57 0.57 0.56 0.98
## Minimum correlation of factor score estimates 0.13 0.14 0.13 0.97
## 
##  Total, General and Subset omega for each subset
##                                                  g  F1*  F2*  F3*
## Omega total for total scores and subscales    0.74 0.61 0.69 0.45
## Omega general for total scores and subscales  0.41 0.24 0.31 0.10
## Omega group for total scores and subscales    0.26 0.37 0.38 0.35
#hsc_T2
alpha(data[, c(27,28,29,30,32,33,34,35,36,37,38)]) #alpha .78
## 
## Reliability analysis   
## Call: alpha(x = data[, c(27, 28, 29, 30, 32, 33, 34, 35, 36, 37, 38)])
## 
##   raw_alpha std.alpha G6(smc) average_r S/N  ase mean   sd median_r
##       0.78      0.78    0.82      0.24 3.5 0.03  4.9 0.81     0.23
## 
##  lower alpha upper     95% confidence boundaries
## 0.72 0.78 0.84 
## 
##  Reliability if an item is dropped:
##          raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## hsc1_T2       0.77      0.77    0.81      0.25 3.4    0.031 0.032  0.24
## hsc2_T2       0.75      0.75    0.79      0.23 3.0    0.035 0.027  0.20
## hsc3_T2       0.78      0.79    0.82      0.27 3.7    0.029 0.030  0.25
## hsc4_T2       0.75      0.76    0.80      0.24 3.1    0.033 0.031  0.20
## hsc6_T2       0.73      0.73    0.77      0.21 2.7    0.037 0.024  0.20
## hsc7_T2       0.79      0.79    0.83      0.27 3.7    0.028 0.030  0.26
## hsc8_T2       0.74      0.74    0.78      0.22 2.9    0.036 0.028  0.20
## hsc9_T2       0.77      0.77    0.82      0.25 3.4    0.031 0.029  0.23
## hsc10_T2      0.78      0.78    0.82      0.27 3.6    0.030 0.031  0.25
## hsc11_T2      0.75      0.75    0.79      0.23 3.0    0.034 0.029  0.20
## hsc12_T2      0.75      0.75    0.79      0.23 2.9    0.034 0.033  0.18
## 
##  Item statistics 
##            n raw.r std.r r.cor r.drop mean   sd
## hsc1_T2  100  0.49  0.49  0.42   0.36  4.7 1.28
## hsc2_T2  100  0.67  0.66  0.65   0.56  4.8 1.48
## hsc3_T2  100  0.33  0.38  0.28   0.20  5.6 1.29
## hsc4_T2  100  0.63  0.61  0.57   0.49  4.5 1.74
## hsc6_T2  100  0.77  0.77  0.78   0.69  4.8 1.39
## hsc7_T2  100  0.36  0.34  0.22   0.18  4.8 1.71
## hsc8_T2   99  0.74  0.71  0.71   0.63  4.3 1.34
## hsc9_T2  100  0.50  0.48  0.40   0.35  3.8 1.51
## hsc10_T2 100  0.33  0.39  0.29   0.23  6.3 0.98
## hsc11_T2  99  0.66  0.64  0.62   0.54  4.7 1.58
## hsc12_T2 100  0.67  0.67  0.64   0.56  5.5 1.38
## 
## Non missing response frequency for each item
##             1    2    3    4    5    6    7 miss
## hsc1_T2  0.02 0.04 0.10 0.20 0.37 0.22 0.05 0.12
## hsc2_T2  0.01 0.08 0.12 0.13 0.30 0.24 0.12 0.12
## hsc3_T2  0.01 0.02 0.03 0.11 0.22 0.33 0.28 0.12
## hsc4_T2  0.07 0.11 0.10 0.11 0.27 0.25 0.09 0.12
## hsc6_T2  0.01 0.08 0.08 0.13 0.40 0.20 0.10 0.12
## hsc7_T2  0.03 0.09 0.09 0.23 0.10 0.27 0.19 0.12
## hsc8_T2  0.00 0.11 0.16 0.23 0.31 0.13 0.05 0.13
## hsc9_T2  0.04 0.20 0.15 0.30 0.17 0.09 0.05 0.12
## hsc10_T2 0.00 0.01 0.02 0.01 0.12 0.31 0.53 0.12
## hsc11_T2 0.02 0.10 0.11 0.14 0.30 0.18 0.14 0.13
## hsc12_T2 0.01 0.05 0.03 0.09 0.22 0.36 0.24 0.12
omega(data[, c(27,28,29,30,32,33,34,35,36,37,38)],3,fm="ml") #omega hierarchical=.64, omega total=.84

## Omega 
## Call: omega(m = data[, c(27, 28, 29, 30, 32, 33, 34, 35, 36, 37, 38)], 
##     nfactors = 3, fm = "ml")
## Alpha:                 0.78 
## G.6:                   0.82 
## Omega Hierarchical:    0.64 
## Omega H asymptotic:    0.77 
## Omega Total            0.84 
## 
## Schmid Leiman Factor loadings greater than  0.2 
##              g   F1*   F2*   F3*   h2   u2   p2
## hsc1_T2   0.29        0.25       0.16 0.84 0.53
## hsc2_T2   0.57        0.72       0.84 0.16 0.38
## hsc3_T2                     0.51 0.29 0.71 0.08
## hsc4_T2   0.52  0.21             0.32 0.68 0.86
## hsc6_T2   0.85  0.33             0.83 0.17 0.87
## hsc7_T2                          0.06 0.94 0.36
## hsc8_T2   0.71  0.26             0.57 0.43 0.88
## hsc9_T2   0.48  0.22       -0.21 0.32 0.68 0.72
## hsc10_T2                    0.66 0.47 0.53 0.06
## hsc11_T2  0.50        0.55       0.56 0.44 0.46
## hsc12_T2  0.56              0.30 0.44 0.56 0.72
## 
## With eigenvalues of:
##    g  F1*  F2*  F3* 
## 2.77 0.29 0.89 0.89 
## 
## general/max  3.11   max/min =   3.03
## mean percent general =  0.54    with sd =  0.3 and cv of  0.56 
## Explained Common Variance of the general factor =  0.57 
## 
## The degrees of freedom are 25  and the fit is  0.45 
## The number of observations was  114  with Chi Square =  48.23  with prob <  0.0035
## The root mean square of the residuals is  0.06 
## The df corrected root mean square of the residuals is  0.08
## RMSEA index =  0.096  and the 10 % confidence intervals are  0.051 0.129
## BIC =  -70.17
## 
## Compare this with the adequacy of just a general factor and no group factors
## The degrees of freedom for just the general factor are 44  and the fit is  1.16 
## The number of observations was  114  with Chi Square =  124.99  with prob <  1.1e-09
## The root mean square of the residuals is  0.11 
## The df corrected root mean square of the residuals is  0.12 
## 
## RMSEA index =  0.132  and the 10 % confidence intervals are  0.102 0.154
## BIC =  -83.4 
## 
## Measures of factor score adequacy             
##                                                  g   F1*  F2*  F3*
## Correlation of scores with factors            0.89  0.40 0.84 0.77
## Multiple R square of scores with factors      0.79  0.16 0.71 0.59
## Minimum correlation of factor score estimates 0.59 -0.67 0.41 0.18
## 
##  Total, General and Subset omega for each subset
##                                                  g  F1*  F2*  F3*
## Omega total for total scores and subscales    0.84 0.79 0.74 0.57
## Omega general for total scores and subscales  0.64 0.68 0.33 0.16
## Omega group for total scores and subscales    0.16 0.11 0.41 0.42
#hsc_T3
alpha(data[, c(48,49,50,51,53,54,55,56,57,58,59)]) #alpha .75
## Some items ( hsc3_T3 hsc10_T3 ) were negatively correlated with the total scale and 
## probably should be reversed.  
## To do this, run the function again with the 'check.keys=TRUE' option
## 
## Reliability analysis   
## Call: alpha(x = data[, c(48, 49, 50, 51, 53, 54, 55, 56, 57, 58, 59)])
## 
##   raw_alpha std.alpha G6(smc) average_r S/N   ase mean   sd median_r
##       0.75      0.73    0.79       0.2 2.8 0.033  5.1 0.72     0.24
## 
##  lower alpha upper     95% confidence boundaries
## 0.68 0.75 0.81 
## 
##  Reliability if an item is dropped:
##          raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## hsc1_T3       0.74      0.73    0.79      0.21 2.6    0.033 0.058  0.25
## hsc2_T3       0.69      0.68    0.74      0.18 2.1    0.040 0.042  0.22
## hsc3_T3       0.77      0.76    0.80      0.24 3.2    0.030 0.045  0.25
## hsc4_T3       0.72      0.71    0.77      0.19 2.4    0.036 0.054  0.21
## hsc6_T3       0.69      0.67    0.73      0.17 2.0    0.041 0.042  0.21
## hsc7_T3       0.75      0.73    0.79      0.21 2.7    0.032 0.056  0.24
## hsc8_T3       0.69      0.67    0.74      0.17 2.1    0.042 0.038  0.21
## hsc9_T3       0.75      0.73    0.79      0.21 2.7    0.033 0.053  0.24
## hsc10_T3      0.76      0.76    0.79      0.24 3.1    0.031 0.044  0.25
## hsc11_T3      0.70      0.69    0.75      0.18 2.2    0.039 0.045  0.22
## hsc12_T3      0.73      0.71    0.76      0.19 2.4    0.035 0.056  0.24
## 
##  Item statistics 
##            n raw.r std.r r.cor r.drop mean   sd
## hsc1_T3  105  0.42  0.45 0.342  0.288  4.8 1.22
## hsc2_T3  105  0.74  0.71 0.725  0.641  5.1 1.45
## hsc3_T3  105  0.11  0.19 0.054 -0.026  6.0 1.10
## hsc4_T3  105  0.59  0.57 0.509  0.455  5.0 1.45
## hsc6_T3  104  0.77  0.76 0.782  0.690  5.3 1.31
## hsc7_T3  105  0.49  0.43 0.312  0.284  4.8 1.82
## hsc8_T3  105  0.78  0.75 0.777  0.694  4.7 1.46
## hsc9_T3  105  0.45  0.42 0.304  0.280  3.9 1.49
## hsc10_T3 105  0.12  0.22 0.112  0.011  6.4 0.85
## hsc11_T3 105  0.70  0.67 0.672  0.577  4.9 1.50
## hsc12_T3 105  0.52  0.57 0.523  0.419  5.7 1.06
## 
## Non missing response frequency for each item
##             1    2    3    4    5    6    7 miss
## hsc1_T3  0.01 0.03 0.11 0.18 0.38 0.23 0.06 0.08
## hsc2_T3  0.02 0.05 0.09 0.10 0.27 0.33 0.14 0.08
## hsc3_T3  0.00 0.01 0.02 0.06 0.22 0.28 0.42 0.08
## hsc4_T3  0.03 0.07 0.03 0.16 0.35 0.23 0.13 0.08
## hsc6_T3  0.02 0.02 0.05 0.13 0.30 0.32 0.16 0.09
## hsc7_T3  0.05 0.10 0.08 0.21 0.12 0.22 0.22 0.08
## hsc8_T3  0.02 0.05 0.14 0.22 0.28 0.17 0.12 0.08
## hsc9_T3  0.06 0.14 0.15 0.28 0.24 0.10 0.04 0.08
## hsc10_T3 0.00 0.00 0.01 0.03 0.10 0.28 0.59 0.08
## hsc11_T3 0.03 0.04 0.10 0.21 0.24 0.24 0.15 0.08
## hsc12_T3 0.00 0.01 0.02 0.09 0.26 0.37 0.26 0.08
omega(data[, c(48,49,50,51,53,54,55,56,57,58,59)],3,fm="ml") #omega hierarchical=.59, omega total=.83

## Omega 
## Call: omega(m = data[, c(48, 49, 50, 51, 53, 54, 55, 56, 57, 58, 59)], 
##     nfactors = 3, fm = "ml")
## Alpha:                 0.75 
## G.6:                   0.8 
## Omega Hierarchical:    0.59 
## Omega H asymptotic:    0.71 
## Omega Total            0.83 
## 
## Schmid Leiman Factor loadings greater than  0.2 
##               g   F1*   F2*   F3*   h2   u2   p2
## hsc1_T3    0.28                   0.11 0.89 0.68
## hsc2_T3    0.96                   0.92 0.08 0.99
## hsc3_T3-                    -0.41 0.17 0.83 0.03
## hsc4_T3    0.32  0.42             0.29 0.71 0.36
## hsc6_T3    0.57  0.71             0.83 0.17 0.39
## hsc7_T3    0.27                   0.10 0.90 0.70
## hsc8_T3    0.70  0.45             0.70 0.30 0.71
## hsc9_T3    0.32                   0.15 0.85 0.67
## hsc10_T3-                   -0.99 1.00 0.00 0.01
## hsc11_T3   0.73                   0.55 0.45 0.97
## hsc12_T3   0.24  0.44        0.28 0.35 0.65 0.16
## 
## With eigenvalues of:
##    g  F1*  F2*  F3* 
## 2.70 1.19 0.01 1.29 
## 
## general/max  2.09   max/min =   162.31
## mean percent general =  0.52    with sd =  0.35 and cv of  0.68 
## Explained Common Variance of the general factor =  0.52 
## 
## The degrees of freedom are 25  and the fit is  0.26 
## The number of observations was  114  with Chi Square =  27.85  with prob <  0.31
## The root mean square of the residuals is  0.04 
## The df corrected root mean square of the residuals is  0.06
## RMSEA index =  0.04  and the 10 % confidence intervals are  0 0.084
## BIC =  -90.55
## 
## Compare this with the adequacy of just a general factor and no group factors
## The degrees of freedom for just the general factor are 44  and the fit is  1.38 
## The number of observations was  114  with Chi Square =  148.56  with prob <  2.9e-13
## The root mean square of the residuals is  0.13 
## The df corrected root mean square of the residuals is  0.14 
## 
## RMSEA index =  0.15  and the 10 % confidence intervals are  0.12 0.171
## BIC =  -59.83 
## 
## Measures of factor score adequacy             
##                                                  g  F1*   F2* F3*
## Correlation of scores with factors            0.97 0.88  0.08   1
## Multiple R square of scores with factors      0.93 0.78  0.01   1
## Minimum correlation of factor score estimates 0.86 0.56 -0.99   1
## 
##  Total, General and Subset omega for each subset
##                                                  g  F1*  F2*  F3*
## Omega total for total scores and subscales    0.83 0.79 0.92 0.71
## Omega general for total scores and subscales  0.59 0.49 0.92 0.01
## Omega group for total scores and subscales    0.26 0.29 0.00 0.70
#hsc_T4
alpha(data[, c(69,70,71,72,74,75,76,77,78,79,80)]) #alpha .79
## 
## Reliability analysis   
## Call: alpha(x = data[, c(69, 70, 71, 72, 74, 75, 76, 77, 78, 79, 80)])
## 
##   raw_alpha std.alpha G6(smc) average_r S/N   ase mean  sd median_r
##       0.79      0.79    0.84      0.25 3.7 0.028    5 0.8     0.22
## 
##  lower alpha upper     95% confidence boundaries
## 0.74 0.79 0.85 
## 
##  Reliability if an item is dropped:
##          raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## hsc1_T4       0.79      0.79    0.84      0.27 3.7    0.028 0.042  0.24
## hsc2_T4       0.77      0.76    0.81      0.24 3.2    0.031 0.036  0.22
## hsc3_T4       0.80      0.80    0.83      0.28 3.9    0.027 0.033  0.24
## hsc4_T4       0.76      0.76    0.81      0.24 3.1    0.032 0.040  0.19
## hsc6_T4       0.75      0.74    0.79      0.23 2.9    0.034 0.032  0.20
## hsc7_T4       0.79      0.78    0.83      0.26 3.6    0.028 0.042  0.22
## hsc8_T4       0.75      0.74    0.79      0.22 2.9    0.034 0.027  0.20
## hsc9_T4       0.78      0.78    0.83      0.26 3.5    0.029 0.042  0.20
## hsc10_T4      0.79      0.79    0.82      0.27 3.7    0.028 0.038  0.24
## hsc11_T4      0.77      0.76    0.81      0.24 3.2    0.031 0.035  0.21
## hsc12_T4      0.75      0.75    0.80      0.23 2.9    0.033 0.036  0.19
## 
##  Item statistics 
##            n raw.r std.r r.cor r.drop mean   sd
## hsc1_T4  106  0.37  0.41  0.29   0.25  4.8 1.17
## hsc2_T4  106  0.61  0.60  0.57   0.49  5.0 1.44
## hsc3_T4  106  0.28  0.34  0.26   0.15  5.9 1.19
## hsc4_T4  106  0.66  0.65  0.61   0.54  4.8 1.58
## hsc6_T4  106  0.75  0.74  0.75   0.66  5.0 1.45
## hsc7_T4  106  0.50  0.47  0.37   0.33  4.9 1.73
## hsc8_T4  106  0.77  0.75  0.76   0.69  4.6 1.42
## hsc9_T4  106  0.50  0.48  0.39   0.36  3.9 1.45
## hsc10_T4 106  0.36  0.43  0.36   0.26  6.3 0.96
## hsc11_T4 106  0.64  0.62  0.60   0.52  4.8 1.57
## hsc12_T4 106  0.73  0.73  0.71   0.65  5.6 1.35
## 
## Non missing response frequency for each item
##             1    2    3    4    5    6    7 miss
## hsc1_T4  0.01 0.02 0.14 0.16 0.39 0.25 0.03 0.07
## hsc2_T4  0.00 0.08 0.10 0.08 0.30 0.30 0.12 0.07
## hsc3_T4  0.00 0.02 0.02 0.08 0.20 0.27 0.41 0.07
## hsc4_T4  0.05 0.05 0.12 0.11 0.33 0.21 0.13 0.07
## hsc6_T4  0.02 0.08 0.08 0.08 0.36 0.27 0.11 0.07
## hsc7_T4  0.04 0.08 0.10 0.15 0.17 0.25 0.20 0.07
## hsc8_T4  0.02 0.05 0.16 0.19 0.32 0.16 0.10 0.07
## hsc9_T4  0.06 0.12 0.18 0.28 0.23 0.10 0.03 0.07
## hsc10_T4 0.00 0.01 0.01 0.03 0.10 0.28 0.57 0.07
## hsc11_T4 0.02 0.09 0.10 0.17 0.26 0.21 0.14 0.07
## hsc12_T4 0.01 0.05 0.02 0.07 0.29 0.29 0.27 0.07
omega(data[, c(69,70,71,72,74,75,76,77,78,79,80)],3,fm="ml") #omega hierarchical=.71, omega total=.86

## Omega 
## Call: omega(m = data[, c(69, 70, 71, 72, 74, 75, 76, 77, 78, 79, 80)], 
##     nfactors = 3, fm = "ml")
## Alpha:                 0.79 
## G.6:                   0.84 
## Omega Hierarchical:    0.71 
## Omega H asymptotic:    0.83 
## Omega Total            0.86 
## 
## Schmid Leiman Factor loadings greater than  0.2 
##              g   F1*   F2*   F3*   h2   u2   p2
## hsc1_T4   0.22              0.24 0.10 0.90 0.46
## hsc2_T4   0.46        0.79       0.83 0.17 0.25
## hsc3_T4                     0.74 0.55 0.45 0.01
## hsc4_T4   0.63                   0.43 0.57 0.94
## hsc6_T4   0.83                   0.70 0.30 0.99
## hsc7_T4   0.39                   0.16 0.84 0.96
## hsc8_T4   0.84        0.23       0.80 0.20 0.89
## hsc9_T4   0.36                   0.14 0.86 0.93
## hsc10_T4                    0.77 0.61 0.39 0.05
## hsc11_T4  0.50        0.55       0.56 0.44 0.45
## hsc12_T4  0.74                   0.56 0.44 0.98
## 
## With eigenvalues of:
##    g  F1*  F2*  F3* 
## 3.17 0.01 1.01 1.24 
## 
## general/max  2.56   max/min =   95.33
## mean percent general =  0.63    with sd =  0.39 and cv of  0.62 
## Explained Common Variance of the general factor =  0.58 
## 
## The degrees of freedom are 25  and the fit is  0.33 
## The number of observations was  114  with Chi Square =  35.47  with prob <  0.08
## The root mean square of the residuals is  0.04 
## The df corrected root mean square of the residuals is  0.06
## RMSEA index =  0.067  and the 10 % confidence intervals are  0 0.104
## BIC =  -82.93
## 
## Compare this with the adequacy of just a general factor and no group factors
## The degrees of freedom for just the general factor are 44  and the fit is  1.41 
## The number of observations was  114  with Chi Square =  152.05  with prob <  8.2e-14
## The root mean square of the residuals is  0.12 
## The df corrected root mean square of the residuals is  0.14 
## 
## RMSEA index =  0.152  and the 10 % confidence intervals are  0.122 0.173
## BIC =  -56.35 
## 
## Measures of factor score adequacy             
##                                                  g   F1*  F2*  F3*
## Correlation of scores with factors            0.94  0.07 0.88 0.87
## Multiple R square of scores with factors      0.88  0.01 0.78 0.75
## Minimum correlation of factor score estimates 0.76 -0.99 0.55 0.50
## 
##  Total, General and Subset omega for each subset
##                                                  g F1*  F2*  F3*
## Omega total for total scores and subscales    0.86 0.7 0.78 0.69
## Omega general for total scores and subscales  0.71 0.7 0.64 0.21
## Omega group for total scores and subscales    0.14 0.0 0.14 0.48
#wb_T1
alpha(data[, c(18:22)]) #alpha .78
## 
## Reliability analysis   
## Call: alpha(x = data[, c(18:22)])
## 
##   raw_alpha std.alpha G6(smc) average_r S/N   ase mean   sd median_r
##       0.78      0.78    0.77      0.42 3.6 0.033  2.7 0.83     0.43
## 
##  lower alpha upper     95% confidence boundaries
## 0.71 0.78 0.84 
## 
##  Reliability if an item is dropped:
##        raw_alpha std.alpha G6(smc) average_r S/N alpha se var.r med.r
## wb1_T1      0.71      0.71    0.68      0.38 2.5    0.044 0.012  0.36
## wb2_T1      0.72      0.73    0.69      0.40 2.7    0.042 0.020  0.39
## wb3_T1      0.72      0.72    0.70      0.39 2.6    0.044 0.019  0.38
## wb4_T1      0.78      0.78    0.75      0.48 3.6    0.033 0.012  0.50
## wb5_T1      0.75      0.75    0.73      0.43 3.0    0.039 0.018  0.44
## 
##  Item statistics 
##          n raw.r std.r r.cor r.drop mean  sd
## wb1_T1 114  0.77  0.78  0.74   0.63  3.1 1.1
## wb2_T1 114  0.75  0.76  0.70   0.59  2.8 1.1
## wb3_T1 113  0.77  0.77  0.70   0.61  2.9 1.2
## wb4_T1 114  0.64  0.63  0.49   0.42  2.1 1.2
## wb5_T1 114  0.71  0.71  0.60   0.52  2.7 1.2
## 
## Non missing response frequency for each item
##           0    1    2    3    4    5 miss
## wb1_T1 0.01 0.05 0.24 0.34 0.27 0.09 0.00
## wb2_T1 0.02 0.11 0.27 0.35 0.20 0.05 0.00
## wb3_T1 0.02 0.10 0.23 0.32 0.25 0.09 0.01
## wb4_T1 0.04 0.31 0.30 0.24 0.08 0.04 0.00
## wb5_T1 0.03 0.13 0.25 0.33 0.19 0.06 0.00
omega(data[, c(18:22)],1,fm="ml") #omega hierarchical=.78, omega total=.79
## Omega_h for 1 factor is not meaningful, just omega_t
## Omega 
## Call: omega(m = data[, c(18:22)], nfactors = 1, fm = "ml")
## Alpha:                 0.78 
## G.6:                   0.77 
## Omega Hierarchical:    0.78 
## Omega H asymptotic:    0.99 
## Omega Total            0.79 
## 
## Schmid Leiman Factor loadings greater than  0.2 
##           g  F1*   h2   u2 p2
## wb1_T1 0.79      0.62 0.38  1
## wb2_T1 0.68      0.46 0.54  1
## wb3_T1 0.71      0.50 0.50  1
## wb4_T1 0.44      0.20 0.80  1
## wb5_T1 0.61      0.37 0.63  1
## 
## With eigenvalues of:
##   g F1* 
## 2.1 0.0 
## 
## general/max  1.933559e+16   max/min =   1
## mean percent general =  1    with sd =  0 and cv of  0 
## Explained Common Variance of the general factor =  1 
## 
## The degrees of freedom are 5  and the fit is  0.23 
## The number of observations was  114  with Chi Square =  25.49  with prob <  0.00011
## The root mean square of the residuals is  0.09 
## The df corrected root mean square of the residuals is  0.12
## RMSEA index =  0.194  and the 10 % confidence intervals are  0.121 0.267
## BIC =  1.8
## 
## Compare this with the adequacy of just a general factor and no group factors
## The degrees of freedom for just the general factor are 5  and the fit is  0.23 
## The number of observations was  114  with Chi Square =  25.49  with prob <  0.00011
## The root mean square of the residuals is  0.09 
## The df corrected root mean square of the residuals is  0.12 
## 
## RMSEA index =  0.194  and the 10 % confidence intervals are  0.121 0.267
## BIC =  1.8 
## 
## Measures of factor score adequacy             
##                                                  g F1*
## Correlation of scores with factors            0.90   0
## Multiple R square of scores with factors      0.81   0
## Minimum correlation of factor score estimates 0.63  -1
## 
##  Total, General and Subset omega for each subset
##                                                  g  F1*
## Omega total for total scores and subscales    0.79 0.78
## Omega general for total scores and subscales  0.78 0.78
## Omega group for total scores and subscales    0.00 0.00
#wb_T2
alpha(data[, c(39:43)]) #alpha .85
## 
## Reliability analysis   
## Call: alpha(x = data[, c(39:43)])
## 
##   raw_alpha std.alpha G6(smc) average_r S/N   ase mean   sd median_r
##       0.84      0.85    0.85      0.52 5.5 0.024    3 0.91     0.48
## 
##  lower alpha upper     95% confidence boundaries
## 0.79 0.84 0.89 
## 
##  Reliability if an item is dropped:
##        raw_alpha std.alpha G6(smc) average_r S/N alpha se  var.r med.r
## wb1_T2      0.80      0.80    0.77      0.50 4.0    0.031 0.0099  0.46
## wb2_T2      0.79      0.79    0.75      0.49 3.8    0.032 0.0081  0.47
## wb3_T2      0.81      0.81    0.81      0.52 4.4    0.030 0.0204  0.47
## wb4_T2      0.83      0.83    0.82      0.56 5.0    0.026 0.0132  0.54
## wb5_T2      0.82      0.83    0.83      0.55 4.9    0.027 0.0168  0.52
## 
##  Item statistics 
##          n raw.r std.r r.cor r.drop mean  sd
## wb1_T2 100  0.81  0.82  0.80   0.70  3.2 1.0
## wb2_T2  99  0.83  0.84  0.82   0.73  3.1 1.1
## wb3_T2 100  0.79  0.79  0.72   0.66  3.1 1.1
## wb4_T2 100  0.75  0.73  0.65   0.58  2.4 1.3
## wb5_T2 100  0.75  0.75  0.65   0.59  3.0 1.2
## 
## Non missing response frequency for each item
##           0    1    2    3    4    5 miss
## wb1_T2 0.00 0.05 0.23 0.30 0.33 0.09 0.12
## wb2_T2 0.00 0.07 0.23 0.28 0.32 0.09 0.13
## wb3_T2 0.00 0.10 0.16 0.36 0.25 0.13 0.12
## wb4_T2 0.02 0.26 0.29 0.23 0.12 0.08 0.12
## wb5_T2 0.00 0.12 0.26 0.28 0.21 0.13 0.12
omega(data[, c(39:43)],1,fm="ml") #omega hierarchical=.83, omega total=.85
## Omega_h for 1 factor is not meaningful, just omega_t
## Omega 
## Call: omega(m = data[, c(39:43)], nfactors = 1, fm = "ml")
## Alpha:                 0.85 
## G.6:                   0.85 
## Omega Hierarchical:    0.83 
## Omega H asymptotic:    0.98 
## Omega Total            0.85 
## 
## Schmid Leiman Factor loadings greater than  0.2 
##           g  F1*   h2   u2 p2
## wb1_T2 0.84      0.71 0.29  1
## wb2_T2 0.86      0.74 0.26  1
## wb3_T2 0.65      0.43 0.57  1
## wb4_T2 0.63      0.40 0.60  1
## wb5_T2 0.60      0.36 0.64  1
## 
## With eigenvalues of:
##   g F1* 
## 2.6 0.0 
## 
## general/max  4.745101e+16   max/min =   1
## mean percent general =  1    with sd =  0 and cv of  0 
## Explained Common Variance of the general factor =  1 
## 
## The degrees of freedom are 5  and the fit is  0.43 
## The number of observations was  114  with Chi Square =  47.58  with prob <  4.3e-09
## The root mean square of the residuals is  0.09 
## The df corrected root mean square of the residuals is  0.13
## RMSEA index =  0.279  and the 10 % confidence intervals are  0.207 0.348
## BIC =  23.9
## 
## Compare this with the adequacy of just a general factor and no group factors
## The degrees of freedom for just the general factor are 5  and the fit is  0.43 
## The number of observations was  114  with Chi Square =  47.58  with prob <  4.3e-09
## The root mean square of the residuals is  0.09 
## The df corrected root mean square of the residuals is  0.13 
## 
## RMSEA index =  0.279  and the 10 % confidence intervals are  0.207 0.348
## BIC =  23.9 
## 
## Measures of factor score adequacy             
##                                                  g F1*
## Correlation of scores with factors            0.94   0
## Multiple R square of scores with factors      0.88   0
## Minimum correlation of factor score estimates 0.76  -1
## 
##  Total, General and Subset omega for each subset
##                                                  g  F1*
## Omega total for total scores and subscales    0.85 0.83
## Omega general for total scores and subscales  0.83 0.83
## Omega group for total scores and subscales    0.00 0.00
#wb_T3
alpha(data[, c(60:64)]) #alpha .85
## 
## Reliability analysis   
## Call: alpha(x = data[, c(60:64)])
## 
##   raw_alpha std.alpha G6(smc) average_r S/N   ase mean   sd median_r
##       0.85      0.85    0.85      0.54 5.8 0.022  2.9 0.94     0.51
## 
##  lower alpha upper     95% confidence boundaries
## 0.81 0.85 0.9 
## 
##  Reliability if an item is dropped:
##        raw_alpha std.alpha G6(smc) average_r S/N alpha se  var.r med.r
## wb1_T3      0.81      0.81    0.78      0.52 4.4    0.029 0.0065  0.50
## wb2_T3      0.81      0.82    0.77      0.53 4.4    0.028 0.0029  0.51
## wb3_T3      0.83      0.83    0.81      0.55 4.8    0.026 0.0105  0.51
## wb4_T3      0.83      0.83    0.81      0.55 4.9    0.027 0.0109  0.53
## wb5_T3      0.83      0.83    0.81      0.55 4.9    0.026 0.0102  0.52
## 
##  Item statistics 
##          n raw.r std.r r.cor r.drop mean  sd
## wb1_T3 105  0.82  0.82  0.78   0.71  3.3 1.1
## wb2_T3 105  0.82  0.81  0.78   0.70  3.0 1.2
## wb3_T3 105  0.78  0.78  0.71   0.65  3.2 1.2
## wb4_T3 105  0.79  0.78  0.70   0.65  2.3 1.3
## wb5_T3 105  0.77  0.77  0.69   0.64  2.7 1.1
## 
## Non missing response frequency for each item
##           0    1    2    3    4    5 miss
## wb1_T3 0.01 0.06 0.17 0.34 0.27 0.15 0.08
## wb2_T3 0.01 0.11 0.21 0.30 0.26 0.10 0.08
## wb3_T3 0.01 0.08 0.16 0.33 0.28 0.14 0.08
## wb4_T3 0.06 0.19 0.38 0.17 0.14 0.06 0.08
## wb5_T3 0.01 0.15 0.26 0.36 0.15 0.07 0.08
omega(data[, c(60:64)],1,fm="ml") #omega hierarchical=.85, omega total=.85
## Omega_h for 1 factor is not meaningful, just omega_t
## Omega 
## Call: omega(m = data[, c(60:64)], nfactors = 1, fm = "ml")
## Alpha:                 0.85 
## G.6:                   0.85 
## Omega Hierarchical:    0.85 
## Omega H asymptotic:    0.99 
## Omega Total            0.85 
## 
## Schmid Leiman Factor loadings greater than  0.2 
##           g  F1*   h2   u2 p2
## wb1_T3 0.81      0.66 0.34  1
## wb2_T3 0.80      0.65 0.35  1
## wb3_T3 0.68      0.47 0.53  1
## wb4_T3 0.70      0.49 0.51  1
## wb5_T3 0.66      0.44 0.56  1
## 
## With eigenvalues of:
##   g F1* 
## 2.7 0.0 
## 
## general/max  Inf   max/min =   NaN
## mean percent general =  1    with sd =  0 and cv of  0 
## Explained Common Variance of the general factor =  1 
## 
## The degrees of freedom are 5  and the fit is  0.3 
## The number of observations was  114  with Chi Square =  32.82  with prob <  4.1e-06
## The root mean square of the residuals is  0.08 
## The df corrected root mean square of the residuals is  0.11
## RMSEA index =  0.226  and the 10 % confidence intervals are  0.153 0.297
## BIC =  9.14
## 
## Compare this with the adequacy of just a general factor and no group factors
## The degrees of freedom for just the general factor are 5  and the fit is  0.3 
## The number of observations was  114  with Chi Square =  32.82  with prob <  4.1e-06
## The root mean square of the residuals is  0.08 
## The df corrected root mean square of the residuals is  0.11 
## 
## RMSEA index =  0.226  and the 10 % confidence intervals are  0.153 0.297
## BIC =  9.14 
## 
## Measures of factor score adequacy             
##                                                  g F1*
## Correlation of scores with factors            0.93   0
## Multiple R square of scores with factors      0.86   0
## Minimum correlation of factor score estimates 0.73  -1
## 
##  Total, General and Subset omega for each subset
##                                                  g  F1*
## Omega total for total scores and subscales    0.85 0.85
## Omega general for total scores and subscales  0.85 0.85
## Omega group for total scores and subscales    0.00 0.00
#wb_T4
alpha(data[, c(81:85)]) #alpha .90
## 
## Reliability analysis   
## Call: alpha(x = data[, c(81:85)])
## 
##   raw_alpha std.alpha G6(smc) average_r S/N   ase mean  sd median_r
##        0.9       0.9     0.9      0.63 8.7 0.016  2.9 1.1     0.63
## 
##  lower alpha upper     95% confidence boundaries
## 0.86 0.9 0.93 
## 
##  Reliability if an item is dropped:
##        raw_alpha std.alpha G6(smc) average_r S/N alpha se  var.r med.r
## wb1_T4      0.86      0.86    0.86      0.61 6.3    0.021 0.0115  0.58
## wb2_T4      0.87      0.87    0.84      0.62 6.6    0.021 0.0053  0.63
## wb3_T4      0.88      0.88    0.87      0.65 7.5    0.018 0.0076  0.63
## wb4_T4      0.88      0.88    0.86      0.64 7.2    0.019 0.0051  0.68
## wb5_T4      0.87      0.88    0.87      0.64 7.1    0.020 0.0123  0.64
## 
##  Item statistics 
##          n raw.r std.r r.cor r.drop mean  sd
## wb1_T4 106  0.86  0.87  0.83   0.79  3.1 1.1
## wb2_T4 106  0.86  0.86  0.84   0.77  2.8 1.3
## wb3_T4 106  0.81  0.81  0.75   0.70  3.1 1.2
## wb4_T4 106  0.83  0.83  0.79   0.73  2.3 1.3
## wb5_T4 106  0.84  0.83  0.77   0.73  2.9 1.3
## 
## Non missing response frequency for each item
##           0    1    2    3    4    5 miss
## wb1_T4 0.01 0.09 0.16 0.32 0.32 0.09 0.07
## wb2_T4 0.03 0.13 0.23 0.30 0.20 0.11 0.07
## wb3_T4 0.01 0.08 0.24 0.29 0.22 0.16 0.07
## wb4_T4 0.06 0.23 0.32 0.20 0.11 0.08 0.07
## wb5_T4 0.04 0.11 0.24 0.28 0.19 0.14 0.07
omega(data[, c(81:85)],1,fm="ml") #omega hierarchical=.90, omega total=.90
## Omega_h for 1 factor is not meaningful, just omega_t
## Omega 
## Call: omega(m = data[, c(81:85)], nfactors = 1, fm = "ml")
## Alpha:                 0.9 
## G.6:                   0.9 
## Omega Hierarchical:    0.9 
## Omega H asymptotic:    1 
## Omega Total            0.9 
## 
## Schmid Leiman Factor loadings greater than  0.2 
##           g  F1*   h2   u2 p2
## wb1_T4 0.84      0.71 0.29  1
## wb2_T4 0.84      0.71 0.29  1
## wb3_T4 0.74      0.55 0.45  1
## wb4_T4 0.79      0.62 0.38  1
## wb5_T4 0.77      0.59 0.41  1
## 
## With eigenvalues of:
##   g F1* 
## 3.2 0.0 
## 
## general/max  Inf   max/min =   NaN
## mean percent general =  1    with sd =  0 and cv of  0 
## Explained Common Variance of the general factor =  1 
## 
## The degrees of freedom are 5  and the fit is  0.43 
## The number of observations was  114  with Chi Square =  46.84  with prob <  6.1e-09
## The root mean square of the residuals is  0.08 
## The df corrected root mean square of the residuals is  0.11
## RMSEA index =  0.276  and the 10 % confidence intervals are  0.204 0.346
## BIC =  23.16
## 
## Compare this with the adequacy of just a general factor and no group factors
## The degrees of freedom for just the general factor are 5  and the fit is  0.43 
## The number of observations was  114  with Chi Square =  46.84  with prob <  6.1e-09
## The root mean square of the residuals is  0.08 
## The df corrected root mean square of the residuals is  0.11 
## 
## RMSEA index =  0.276  and the 10 % confidence intervals are  0.204 0.346
## BIC =  23.16 
## 
## Measures of factor score adequacy             
##                                                  g F1*
## Correlation of scores with factors            0.95   0
## Multiple R square of scores with factors      0.90   0
## Minimum correlation of factor score estimates 0.80  -1
## 
##  Total, General and Subset omega for each subset
##                                                 g F1*
## Omega total for total scores and subscales    0.9 0.9
## Omega general for total scores and subscales  0.9 0.9
## Omega group for total scores and subscales    0.0 0.0

1-6. 欠損値分析

library(BaylorEdPsych)
missingdata <- data %>% dplyr::select(hsc_T1,hsc_T2,hsc_T3,hsc_T4,wb_T1,wb_T2,wb_T3,wb_T4,ev_T1,ev_T2,ev_T3,ev_T4,hsc_onemonth,wb_onemonth,ev_onemonth) #欠損値分析用のデータセット作成
LittleMCAR(missingdata)
## Loading required package: mvnmle
## this could take a while
## $chi.square
## [1] 450.7459
## 
## $df
## [1] 190
## 
## $p.value
## [1] 0
## 
## $missing.patterns
## [1] 21
## 
## $amount.missing
##                     hsc_T1     hsc_T2     hsc_T3     hsc_T4      wb_T1
## Number Missing  1.00000000 16.0000000 10.0000000 10.0000000 1.00000000
## Percent Missing 0.00877193  0.1403509  0.0877193  0.0877193 0.00877193
##                      wb_T2      wb_T3      wb_T4      ev_T1      ev_T2
## Number Missing  15.0000000 9.00000000 8.00000000 1.00000000 19.0000000
## Percent Missing  0.1315789 0.07894737 0.07017544 0.00877193  0.1666667
##                       ev_T3      ev_T4 hsc_onemonth wb_onemonth
## Number Missing  11.00000000 13.0000000    28.000000  26.0000000
## Percent Missing  0.09649123  0.1140351     0.245614   0.2280702
##                 ev_onemonth
## Number Missing   30.0000000
## Percent Missing   0.2631579
## 
## $data
## $data$DataSet1
##       hsc_T1   hsc_T2   hsc_T3   hsc_T4 wb_T1 wb_T2 wb_T3 wb_T4 ev_T1
## 2   5.416667 5.633333 5.416667 5.966667   3.4   3.8   3.0   3.6   0.5
## 4   5.616667 5.683333 5.533333 5.766667   4.0   3.4   3.4   4.4   2.0
## 5   4.750000 5.066667 5.033333 5.000000   2.2   3.8   2.2   2.6   0.0
## 6   5.316667 5.116667 5.800000 5.900000   2.8   3.4   2.4   2.8   1.0
## 7   6.083333 6.283333 6.916667 7.000000   2.0   1.4   1.0   0.8   3.0
## 8   5.666667 4.983333 5.133333 5.300000   3.0   2.2   2.4   2.4   0.5
## 10  6.300000 6.233333 6.133333 6.283333   1.6   2.0   2.6   4.0   0.0
## 11  5.516667 5.816667 6.366667 6.416667   1.6   2.4   2.6   2.6  -2.0
## 12  5.150000 5.183333 5.100000 4.883333   2.8   3.0   3.2   3.2   0.0
## 13  5.566667 5.100000 5.166667 5.316667   2.4   3.0   2.6   3.2   0.0
## 15  4.916667 5.383333 4.450000 4.250000   3.8   3.8   3.6   4.2   3.0
## 17  5.733333 6.016667 6.150000 6.483333   1.6   2.2   1.4   1.8  -0.5
## 21  5.500000 4.100000 4.966667 4.783333   3.6   3.6   3.8   3.4   0.0
## 22  4.650000 4.633333 4.950000 4.866667   1.8   1.6   1.8   2.0  -0.5
## 25  5.566667 3.066667 5.950000 3.833333   2.8   2.6   2.2   1.6   2.5
## 26  5.800000 6.016667 5.883333 6.250000   2.2   1.6   1.6   2.0  -0.5
## 27  5.466667 5.700000 5.300000 5.150000   4.0   4.0   3.8   3.2   0.0
## 28  4.450000 4.516667 4.916667 4.516667   1.8   3.0   3.0   2.2   1.0
## 32  6.383333 6.066667 6.133333 6.050000   2.2   2.2   2.2   2.4   0.5
## 34  5.233333 5.466667 5.333333 5.533333   0.6   1.8   1.8   2.4  -1.5
## 35  6.466667 5.616667 4.966667 3.916667   4.2   4.6   4.6   4.4   3.0
## 40  5.333333 5.233333 5.483333 5.483333   2.0   2.2   1.8   1.8   0.0
## 41  5.683333 4.733333 3.950000 4.650000   1.4   1.2   1.0   1.0   0.0
## 44  5.066667 4.900000 6.450000 5.033333   2.8   3.4   2.0   3.2   2.5
## 47  5.533333 6.066667 6.016667 5.900000   2.4   2.6   3.2   1.4   2.5
## 48  5.516667 6.150000 6.116667 5.716667   3.0   2.8   2.4   4.0  -0.5
## 49  5.583333 5.950000 6.083333 6.433333   3.4   3.2   4.0   1.2   2.5
## 52  4.383333 5.150000 4.483333 5.200000   3.0   2.6   2.8   2.6   2.5
## 53  4.866667 4.650000 5.183333 5.366667   3.0   2.0   1.8   2.8  -2.5
## 54  4.500000 5.450000 5.133333 5.383333   2.2   1.0   1.4   1.0   3.0
## 55  4.433333 4.166667 4.283333 4.233333   2.6   3.4   2.8   2.6   0.0
## 56  5.483333 5.616667 5.716667 5.733333   2.0   1.8   2.2   2.0   0.5
## 57  4.800000 5.300000 5.816667 5.766667   2.6   2.4   2.6   2.2  -0.5
## 60  4.116667 4.783333 4.566667 4.833333   4.0   3.8   3.2   4.2  -1.5
## 62  3.183333 2.916667 3.500000 3.083333   4.6   5.0   4.8   5.0   3.0
## 63  4.850000 4.883333 5.250000 5.250000   3.0   3.0   3.6   2.6   3.0
## 66  6.116667 5.666667 5.683333 5.850000   2.8   2.6   2.8   3.2  -3.0
## 68  4.350000 4.100000 4.016667 3.933333   2.8   2.6   2.8   3.0   0.5
## 69  4.766667 4.783333 4.933333 5.550000   2.0   1.8   2.4   1.8  -0.5
## 70  4.016667 4.316667 4.800000 4.616667   3.2   2.6   2.8   2.8   3.0
## 71  5.450000 5.433333 5.683333 5.983333   1.8   1.6   0.8   0.8   2.0
## 72  5.383333 5.683333 5.416667 5.883333   3.4   3.0   2.4   2.6  -0.5
## 73  5.166667 5.433333 5.333333 4.333333   2.6   2.2   3.2   3.2   0.0
## 74  4.516667 4.233333 4.533333 4.616667   3.0   3.2   2.8   2.8   3.0
## 75  4.183333 4.166667 4.700000 4.716667   2.2   3.0   2.4   2.0   0.5
## 77  4.850000 4.883333 5.166667 4.633333   3.6   2.2   2.8   3.6  -0.5
## 78  5.800000 5.533333 6.050000 5.750000   3.6   4.2   3.4   2.6   3.0
## 79  6.066667 5.800000 5.000000 4.350000   3.4   4.4   5.0   5.0  -1.5
## 80  5.800000 5.766667 5.983333 5.700000   3.0   2.8   3.0   2.4   1.0
## 81  5.000000 5.866667 4.866667 5.866667   3.0   4.0   3.8   3.2   2.0
## 82  4.500000 4.400000 3.383333 3.850000   3.2   1.6   3.4   3.2   1.0
## 83  3.383333 4.016667 4.083333 4.066667   3.0   3.2   3.2   2.8   0.5
## 84  4.683333 4.933333 4.983333 5.300000   2.4   2.6   3.0   1.8   2.5
## 85  4.483333 4.733333 4.566667 4.800000   2.2   1.8   2.2   3.2  -1.5
## 86  5.800000 5.700000 6.000000 5.683333   4.4   3.8   3.8   4.2   0.5
## 87  4.266667 5.233333 5.033333 5.116667   2.2   3.2   3.4   3.0   0.5
## 88  5.216667 5.183333 5.500000 5.416667   3.0   3.0   2.8   2.2   3.0
## 90  5.433333 5.783333 6.383333 5.350000   4.2   3.0   3.8   3.4   3.0
## 92  3.983333 4.516667 5.483333 6.183333   1.8   3.2   3.0   2.0   2.5
## 93  5.016667 5.000000 4.916667 4.933333   2.8   3.0   2.8   2.8   2.5
## 94  4.850000 4.866667 4.700000 4.633333   2.4   2.0   2.0   2.0   1.0
## 95  4.316667 6.683333 6.166667 5.750000   2.0   2.0   2.2   2.2   0.0
## 96  4.733333 4.466667 4.766667 4.750000   2.6   1.8   2.0   2.4   2.5
## 97  5.433333 5.883333 6.033333 6.250000   3.2   3.6   3.8   3.8   2.5
## 99  3.400000 3.616667 3.483333 3.633333   3.4   3.8   3.4   2.8   3.0
## 100 5.216667 5.016667 5.400000 5.466667   3.2   3.2   4.0   4.2   0.0
## 101 3.300000 3.850000 3.916667 3.933333   2.6   3.0   4.0   3.6   3.0
## 102 4.483333 4.933333 5.416667 5.316667   2.8   2.4   2.6   2.6   3.0
## 103 5.566667 5.516667 5.800000 5.333333   2.6   3.4   3.2   3.4   3.0
## 104 6.600000 6.800000 6.800000 6.550000   5.0   4.6   4.0   4.6   3.0
## 106 4.483333 4.433333 3.766667 4.366667   2.6   4.0   3.6   1.6   1.0
## 107 5.900000 6.233333 6.450000 6.450000   2.4   3.4   3.2   2.8   3.0
## 108 5.316667 5.333333 5.616667 5.433333   3.8   5.0   3.0   5.0   0.5
## 109 5.283333 4.550000 5.050000 5.816667   2.8   4.4   3.0   3.2   0.0
## 110 5.483333 5.350000 6.100000 5.633333   3.2   4.4   5.0   5.0   0.0
## 111 4.283333 4.033333 4.866667 4.833333   3.0   4.2   3.6   3.4  -1.0
## 112 5.166667 5.700000 5.733333 5.550000   3.4   3.0   3.0   2.2   2.5
## 113 5.200000 5.283333 4.983333 4.850000   3.8   3.0   5.0   5.0   1.0
## 114 4.883333 5.150000 5.233333 5.533333   3.8   4.4   4.6   4.2   3.0
##     ev_T2 ev_T3 ev_T4 hsc_onemonth wb_onemonth ev_onemonth
## 2     0.5   0.5   2.5     5.608333        3.45       1.000
## 4    -1.0   0.0   2.0     5.650000        3.80       0.750
## 5     3.0   0.0   0.0     4.962500        2.70       0.750
## 6     0.5   3.0   1.0     5.533333        2.85       1.375
## 7    -2.5  -3.0   1.5     6.570833        1.30      -0.250
## 8     0.0   2.0   1.0     5.270833        2.50       0.875
## 10    0.5   0.5   0.0     6.237500        2.55       0.250
## 11    0.0   0.0   1.5     6.029167        2.30      -0.125
## 12    0.5   0.5   2.5     5.079167        3.05       0.875
## 13    2.5   1.0   3.0     5.287500        2.80       1.625
## 15    2.5   2.0   3.0     4.750000        3.85       2.625
## 17   -0.5   0.5   3.0     6.095833        1.75       0.625
## 21   -2.0   3.0   0.0     4.837500        3.60       0.250
## 22    0.0   0.0   1.0     4.775000        1.80       0.125
## 25    0.0  -0.5  -3.0     4.604167        2.30      -0.250
## 26   -1.0   0.5   0.5     5.987500        1.85      -0.125
## 27    0.0  -2.0   2.0     5.404167        3.75       0.000
## 28    0.0  -0.5  -0.5     4.600000        2.50       0.000
## 32    2.5   0.0   3.0     6.158333        2.25       1.500
## 34   -0.5   2.5   2.0     5.391667        1.65       0.625
## 35    3.0   0.5   0.5     5.241667        4.45       1.750
## 40   -2.5   1.0   2.0     5.383333        1.95       0.125
## 41   -2.5  -0.5   0.0     4.754167        1.15      -0.750
## 44    3.0  -3.0   3.0     5.362500        2.85       1.375
## 47   -0.5   0.0   3.0     5.879167        2.40       1.250
## 48   -3.0  -3.0   0.0     5.875000        3.05      -1.625
## 49    1.0  -1.5  -1.0     6.012500        2.95       0.250
## 52    1.0   3.0   1.0     4.804167        2.75       1.875
## 53   -1.0   0.0   1.5     5.016667        2.40      -0.500
## 54   -2.5  -2.0  -3.0     5.116667        1.40      -1.125
## 55    2.5  -3.0  -3.0     4.279167        2.85      -0.875
## 56    1.5   3.0   0.0     5.637500        2.00       1.250
## 57    0.0  -1.0   0.5     5.420833        2.45      -0.250
## 60    0.0   0.0   2.5     4.575000        3.80       0.250
## 62    0.0   0.0   0.0     3.170833        4.85       0.750
## 63    1.0   0.5   1.5     5.058333        3.05       1.500
## 66    2.5   1.5  -0.5     5.829167        2.85       0.125
## 68    2.0   2.5   1.5     4.100000        2.80       1.625
## 69    0.0   1.5   0.5     5.008333        2.00       0.375
## 70    3.0   0.5   2.0     4.437500        2.85       2.125
## 71    2.0   3.0  -2.0     5.637500        1.25       1.250
## 72    3.0   3.0   3.0     5.591667        2.85       2.125
## 73    0.0   0.5  -0.5     5.066667        2.80       0.000
## 74    2.0   1.0   3.0     4.475000        2.95       2.250
## 75    0.5   1.5   2.0     4.441667        2.40       1.125
## 77   -1.5   0.5  -1.0     4.883333        3.05      -0.625
## 78    3.0   2.0   2.5     5.783333        3.45       2.625
## 79    0.0   0.5   1.5     5.304167        4.45       0.125
## 80    1.5  -0.5   0.0     5.812500        2.80       0.500
## 81    2.0   2.0   0.0     5.400000        3.50       1.500
## 82    1.0   0.5  -0.5     4.033333        2.85       0.500
## 83    0.5   2.0  -1.0     3.887500        3.05       0.500
## 84    1.0   0.5   1.5     4.975000        2.45       1.375
## 85    0.5   3.0   1.0     4.645833        2.35       0.750
## 86    2.5   2.5   2.0     5.795833        4.05       1.875
## 87   -2.5   0.5   1.5     4.912500        2.95       0.000
## 88    3.0   1.0   0.0     5.329167        2.75       1.750
## 90    0.0   0.0   3.0     5.737500        3.60       1.500
## 92    0.0  -0.5   0.0     5.041667        2.50       0.500
## 93    2.5   1.5   0.5     4.966667        2.85       1.750
## 94    1.0   1.0   1.0     4.762500        2.10       1.000
## 95   -1.5   0.0   0.0     5.729167        2.10      -0.375
## 96    0.5  -1.0   1.0     4.679167        2.20       0.750
## 97    0.0   2.0   3.0     5.900000        3.60       1.875
## 99    1.0   3.0  -0.5     3.533333        3.35       1.625
## 100   2.0   3.0   0.5     5.275000        3.65       1.375
## 101   3.0   3.0   2.0     3.750000        3.30       2.750
## 102   2.5   1.0   2.5     5.037500        2.60       2.250
## 103   2.5  -2.0   0.0     5.554167        3.15       0.875
## 104   2.5   2.5   2.0     6.687500        4.55       2.500
## 106   0.0   0.0   0.0     4.262500        2.95       0.250
## 107   3.0   3.0   2.5     6.258333        2.95       2.875
## 108   0.0   0.5   0.0     5.425000        4.20       0.250
## 109   0.5   0.0   0.0     5.175000        3.35       0.125
## 110   3.0   1.5   1.0     5.641667        4.40       1.375
## 111   1.5  -0.5   0.5     4.504167        3.55       0.125
## 112   3.0   3.0   3.0     5.537500        2.90       2.875
## 113   0.0   2.0   0.0     5.079167        4.20       0.750
## 114   0.0   1.5   0.0     5.200000        4.25       1.125
## 
## $data$DataSet2
##    hsc_T1 hsc_T2   hsc_T3   hsc_T4 wb_T1 wb_T2 wb_T3 wb_T4 ev_T1 ev_T2
## 89     NA   4.05 4.216667 4.533333   2.6   3.2   3.8     4   0.5   2.5
##    ev_T3 ev_T4 hsc_onemonth wb_onemonth ev_onemonth
## 89     1     3           NA         3.4        1.75
## 
## $data$DataSet3
##      hsc_T1   hsc_T2 hsc_T3   hsc_T4 wb_T1 wb_T2 wb_T3 wb_T4 ev_T1 ev_T2
## 67 4.766667 4.516667     NA 4.866667   2.6   1.6   1.8   2.6   0.5   2.5
##    ev_T3 ev_T4 hsc_onemonth wb_onemonth ev_onemonth
## 67    -3     1           NA        2.15        0.25
## 
## $data$DataSet4
##      hsc_T1 hsc_T2 hsc_T3 hsc_T4 wb_T1 wb_T2 wb_T3 wb_T4 ev_T1 ev_T2 ev_T3
## 91 4.066667     NA    5.4     NA     3     5     4     5   2.5     0   0.5
##    ev_T4 hsc_onemonth wb_onemonth ev_onemonth
## 91     3           NA        4.25         1.5
## 
## $data$DataSet5
##      hsc_T1 hsc_T2   hsc_T3   hsc_T4 wb_T1 wb_T2 wb_T3 wb_T4 ev_T1 ev_T2
## 98 4.816667   4.95 5.666667 5.783333    NA     3   2.4   2.2     1     0
##    ev_T3 ev_T4 hsc_onemonth wb_onemonth ev_onemonth
## 98     0   0.5     5.304167          NA       0.375
## 
## $data$DataSet6
##    hsc_T1   hsc_T2   hsc_T3 hsc_T4 wb_T1 wb_T2 wb_T3 wb_T4 ev_T1 ev_T2
## 61    5.7 5.666667 5.733333    5.4   2.6    NA   2.4     2   0.5    -3
##    ev_T3 ev_T4 hsc_onemonth wb_onemonth ev_onemonth
## 61  -0.5     0        5.625          NA       -0.75
## 
## $data$DataSet7
##    hsc_T1   hsc_T2   hsc_T3   hsc_T4 wb_T1 wb_T2 wb_T3 wb_T4 ev_T1 ev_T2
## 20   4.15 4.550000 4.150000 4.233333   4.2   4.0   4.4   3.8   3.0    NA
## 37   5.00 4.566667 4.400000 4.333333   3.2   3.2   2.6   3.8   2.5    NA
## 50   5.85 5.683333 6.566667 6.116667   1.4   2.6   3.8   3.4   2.5    NA
##    ev_T3 ev_T4 hsc_onemonth wb_onemonth ev_onemonth
## 20     3   2.5     4.270833         4.1          NA
## 37     2   2.0     4.575000         3.2          NA
## 50     2   0.5     6.054167         2.8          NA
## 
## $data$DataSet8
##      hsc_T1   hsc_T2   hsc_T3   hsc_T4 wb_T1 wb_T2 wb_T3 wb_T4 ev_T1 ev_T2
## 31 6.133333 5.416667 4.883333 3.183333   3.6   2.4   2.4   0.6   0.5     1
##    ev_T3 ev_T4 hsc_onemonth wb_onemonth ev_onemonth
## 31     0    NA     4.904167        2.25          NA
## 
## $data$DataSet9
##       hsc_T1 hsc_T2 hsc_T3   hsc_T4 wb_T1 wb_T2 wb_T3 wb_T4 ev_T1 ev_T2
## 105 3.966667      4      4 4.616667     3     3     3   2.6    NA    NA
##     ev_T3 ev_T4 hsc_onemonth wb_onemonth ev_onemonth
## 105    NA    NA     4.145833         2.9          NA
## 
## $data$DataSet10
##    hsc_T1 hsc_T2   hsc_T3   hsc_T4 wb_T1 wb_T2 wb_T3 wb_T4 ev_T1 ev_T2
## 59   4.75     NA 4.433333 4.666667   2.2   2.4   2.6   2.6     0    NA
##    ev_T3 ev_T4 hsc_onemonth wb_onemonth ev_onemonth
## 59  -0.5    NA           NA        2.45          NA
## 
## $data$DataSet11
##      hsc_T1 hsc_T2   hsc_T3   hsc_T4 wb_T1 wb_T2 wb_T3 wb_T4 ev_T1 ev_T2
## 14 5.483333     NA 5.550000 5.783333   1.8    NA   2.8   2.2   0.0    NA
## 23 5.116667     NA 5.133333 5.166667   1.6    NA   3.0   3.4  -1.0    NA
## 29 5.833333     NA 5.633333 5.683333   2.0    NA   1.4   2.0  -3.0    NA
## 30 5.616667     NA 5.433333 5.566667   2.2    NA   3.2   3.6  -1.5    NA
## 39 4.850000     NA 5.100000 4.900000   3.8    NA   4.6   4.6   1.0    NA
## 51 5.333333     NA 4.766667 4.766667   2.2    NA   2.0   1.2  -1.5    NA
## 65 5.366667     NA 5.116667 5.100000   2.0    NA   2.2   2.6   1.5    NA
##    ev_T3 ev_T4 hsc_onemonth wb_onemonth ev_onemonth
## 14   0.5   0.5           NA          NA          NA
## 23   2.5   0.0           NA          NA          NA
## 29  -3.0  -0.5           NA          NA          NA
## 30   0.0   0.0           NA          NA          NA
## 39   3.0   0.5           NA          NA          NA
## 51   0.0  -0.5           NA          NA          NA
## 65  -1.0  -0.5           NA          NA          NA
## 
## $data$DataSet12
##     hsc_T1 hsc_T2   hsc_T3 hsc_T4 wb_T1 wb_T2 wb_T3 wb_T4 ev_T1 ev_T2
## 1 5.733333     NA 6.216667     NA   1.4    NA     0   0.2    -3    NA
##   ev_T3 ev_T4 hsc_onemonth wb_onemonth ev_onemonth
## 1    -3  -0.5           NA          NA          NA
## 
## $data$DataSet13
##      hsc_T1   hsc_T2 hsc_T3   hsc_T4 wb_T1 wb_T2 wb_T3 wb_T4 ev_T1 ev_T2
## 3  5.616667 5.250000     NA 4.783333   3.6   3.4    NA   3.0   0.5   0.5
## 18 4.933333 4.533333     NA 4.783333   1.2   1.8    NA   2.6   0.5   1.0
## 43 3.933333 3.716667     NA 3.583333   3.6   4.4    NA   4.0   0.0   3.0
## 64 3.650000 4.500000     NA 4.950000   2.8   2.4    NA   2.2   0.0  -1.0
##    ev_T3 ev_T4 hsc_onemonth wb_onemonth ev_onemonth
## 3     NA   0.5           NA          NA          NA
## 18    NA  -0.5           NA          NA          NA
## 43    NA   3.0           NA          NA          NA
## 64    NA   0.5           NA          NA          NA
## 
## $data$DataSet14
##    hsc_T1 hsc_T2   hsc_T3   hsc_T4 wb_T1 wb_T2 wb_T3 wb_T4 ev_T1 ev_T2
## 38   5.05     NA 5.583333 5.116667   3.4    NA   3.8   3.4     1    NA
##    ev_T3 ev_T4 hsc_onemonth wb_onemonth ev_onemonth
## 38    NA   0.5           NA          NA          NA
## 
## $data$DataSet15
##    hsc_T1 hsc_T2 hsc_T3   hsc_T4 wb_T1 wb_T2 wb_T3 wb_T4 ev_T1 ev_T2 ev_T3
## 42   4.35     NA     NA 4.916667   2.2    NA    NA   1.2  -1.5    NA    NA
##    ev_T4 hsc_onemonth wb_onemonth ev_onemonth
## 42   0.5           NA          NA          NA
## 
## $data$DataSet16
##      hsc_T1   hsc_T2   hsc_T3 hsc_T4 wb_T1 wb_T2 wb_T3 wb_T4 ev_T1 ev_T2
## 16 5.300000 5.200000 5.416667     NA   2.8   2.2   2.2    NA  -0.5    -3
## 33 5.316667 5.200000 5.133333     NA   3.0   3.2   3.0    NA   1.0     2
## 76 4.850000 5.416667 5.316667     NA   1.4   3.2   2.4    NA  -1.0     0
##    ev_T3 ev_T4 hsc_onemonth wb_onemonth ev_onemonth
## 16     0    NA           NA          NA          NA
## 33     0    NA           NA          NA          NA
## 76     1    NA           NA          NA          NA
## 
## $data$DataSet17
##    hsc_T1 hsc_T2 hsc_T3   hsc_T4 wb_T1 wb_T2 wb_T3 wb_T4 ev_T1 ev_T2 ev_T3
## 19   5.25     NA    5.7 5.766667   2.6    NA     3   2.4     0    NA     0
##    ev_T4 hsc_onemonth wb_onemonth ev_onemonth
## 19    NA           NA          NA          NA
## 
## $data$DataSet18
##      hsc_T1 hsc_T2   hsc_T3 hsc_T4 wb_T1 wb_T2 wb_T3 wb_T4 ev_T1 ev_T2
## 24 5.766667     NA 5.516667     NA   1.4    NA   2.0    NA   2.5    NA
## 36 5.916667     NA 6.333333     NA   1.6    NA   3.8    NA  -1.0    NA
##    ev_T3 ev_T4 hsc_onemonth wb_onemonth ev_onemonth
## 24     2    NA           NA          NA          NA
## 36     3    NA           NA          NA          NA
## 
## $data$DataSet19
##     hsc_T1   hsc_T2 hsc_T3   hsc_T4 wb_T1 wb_T2 wb_T3 wb_T4 ev_T1 ev_T2
## 9 3.416667 2.533333     NA 2.616667   1.8     3    NA     4   0.5  -1.5
##   ev_T3 ev_T4 hsc_onemonth wb_onemonth ev_onemonth
## 9    NA    NA           NA          NA          NA
## 
## $data$DataSet20
##      hsc_T1   hsc_T2 hsc_T3 hsc_T4 wb_T1 wb_T2 wb_T3 wb_T4 ev_T1 ev_T2
## 46 3.766667 3.600000     NA     NA   0.8   2.4    NA    NA   0.0     3
## 58 5.283333 4.766667     NA     NA   3.2   3.8    NA    NA   0.5     3
##    ev_T3 ev_T4 hsc_onemonth wb_onemonth ev_onemonth
## 46    NA    NA           NA          NA          NA
## 58    NA    NA           NA          NA          NA
## 
## $data$DataSet21
##      hsc_T1 hsc_T2 hsc_T3 hsc_T4 wb_T1 wb_T2 wb_T3 wb_T4 ev_T1 ev_T2 ev_T3
## 45 4.633333     NA     NA     NA   3.6    NA    NA    NA     0    NA    NA
##    ev_T4 hsc_onemonth wb_onemonth ev_onemonth
## 45    NA           NA          NA          NA

1-7. 級内相関係数

#irrパッケージ読み込み
library(irr)
## Loading required package: lpSolve
#ICCに必要な変数だけのデータセットを作成
icc_hsc <- data %>% dplyr::select("hsc_T1", "hsc_T2", "hsc_T3", "hsc_T4")
icc_wb <- data %>% dplyr::select("wb_T1", "wb_T2", "wb_T3", "wb_T4")
icc_ev <- data %>% dplyr::select("ev_T1", "ev_T2", "ev_T3", "ev_T4")

#ICC算出
icc(icc_hsc, "twoway", "agreement") #ICC = 0.70 [0.61 < ICC < 0.77]
##  Single Score Intraclass Correlation
## 
##    Model: twoway 
##    Type : agreement 
## 
##    Subjects = 86 
##      Raters = 4 
##    ICC(A,1) = 0.697
## 
##  F-Test, H0: r0 = 0 ; H1: r0 > 0 
##   F(85,250) = 10.4 , p = 6.28e-48 
## 
##  95%-Confidence Interval for ICC Population Values:
##   0.612 < ICC < 0.774
icc(icc_wb, "twoway", "agreement") #ICC = 0.66 [0.57 < ICC < 0.74]
##  Single Score Intraclass Correlation
## 
##    Model: twoway 
##    Type : agreement 
## 
##    Subjects = 88 
##      Raters = 4 
##    ICC(A,1) = 0.66
## 
##  F-Test, H0: r0 = 0 ; H1: r0 > 0 
##   F(87,264) = 8.76 , p = 4.52e-43 
## 
##  95%-Confidence Interval for ICC Population Values:
##   0.57 < ICC < 0.743
icc(icc_ev, "twoway", "agreement") #ICC = 0.18 [0.10 < ICC < 0.30]
##  Single Score Intraclass Correlation
## 
##    Model: twoway 
##    Type : agreement 
## 
##    Subjects = 84 
##      Raters = 4 
##    ICC(A,1) = 0.182
## 
##  F-Test, H0: r0 = 0 ; H1: r0 > 0 
##   F(83,251) = 1.89 , p = 8.71e-05 
## 
##  95%-Confidence Interval for ICC Population Values:
##   0.08 < ICC < 0.302

1-8. 4時点にわたる自己相関係数

#HSC
cor.test(icc_hsc$hsc_T1, icc_hsc$hsc_T2)
## 
##  Pearson's product-moment correlation
## 
## data:  icc_hsc$hsc_T1 and icc_hsc$hsc_T2
## t = 10.904, df = 95, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.6415053 0.8226747
## sample estimates:
##       cor 
## 0.7455598
cor.test(icc_hsc$hsc_T1, icc_hsc$hsc_T3)
## 
##  Pearson's product-moment correlation
## 
## data:  icc_hsc$hsc_T1 and icc_hsc$hsc_T3
## t = 9.4725, df = 101, p-value = 1.303e-15
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.5677280 0.7763658
## sample estimates:
##      cor 
## 0.685894
cor.test(icc_hsc$hsc_T1, icc_hsc$hsc_T4)
## 
##  Pearson's product-moment correlation
## 
## data:  icc_hsc$hsc_T1 and icc_hsc$hsc_T4
## t = 6.8905, df = 101, p-value = 4.863e-10
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.4176639 0.6841380
## sample estimates:
##       cor 
## 0.5654817
cor.test(icc_hsc$hsc_T2, icc_hsc$hsc_T3)
## 
##  Pearson's product-moment correlation
## 
## data:  icc_hsc$hsc_T2 and icc_hsc$hsc_T3
## t = 10.543, df = 88, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.6388470 0.8263396
## sample estimates:
##       cor 
## 0.7470975
cor.test(icc_hsc$hsc_T3, icc_hsc$hsc_T4)
## 
##  Pearson's product-moment correlation
## 
## data:  icc_hsc$hsc_T3 and icc_hsc$hsc_T4
## t = 13.236, df = 95, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.7217009 0.8656593
## sample estimates:
##       cor 
## 0.8052401
#WB
cor.test(icc_wb$wb_T1, icc_wb$wb_T2)
## 
##  Pearson's product-moment correlation
## 
## data:  icc_wb$wb_T1 and icc_wb$wb_T2
## t = 7.9501, df = 96, p-value = 3.623e-12
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.4933338 0.7364297
## sample estimates:
##       cor 
## 0.6300777
cor.test(icc_wb$wb_T1, icc_wb$wb_T3)
## 
##  Pearson's product-moment correlation
## 
## data:  icc_wb$wb_T1 and icc_wb$wb_T3
## t = 8.2783, df = 102, p-value = 5.073e-13
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.5027151 0.7365885
## sample estimates:
##       cor 
## 0.6339283
cor.test(icc_wb$wb_T1, icc_wb$wb_T4)
## 
##  Pearson's product-moment correlation
## 
## data:  icc_wb$wb_T1 and icc_wb$wb_T4
## t = 7.024, df = 103, p-value = 2.386e-10
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.4236354 0.6859388
## sample estimates:
##       cor 
## 0.5690925
cor.test(icc_wb$wb_T2, icc_wb$wb_T3)
## 
##  Pearson's product-moment correlation
## 
## data:  icc_wb$wb_T2 and icc_wb$wb_T3
## t = 10.81, df = 90, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.6462816 0.8288334
## sample estimates:
##       cor 
## 0.7516088
cor.test(icc_wb$wb_T3, icc_wb$wb_T4)
## 
##  Pearson's product-moment correlation
## 
## data:  icc_wb$wb_T3 and icc_wb$wb_T4
## t = 11.151, df = 98, p-value < 2.2e-16
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.6463498 0.8233120
## sample estimates:
##       cor 
## 0.7478276
#LE
cor.test(icc_ev$ev_T1, icc_ev$ev_T2)
## 
##  Pearson's product-moment correlation
## 
## data:  icc_ev$ev_T1 and icc_ev$ev_T2
## t = 2.5529, df = 93, p-value = 0.01231
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.05732192 0.43501490
## sample estimates:
##       cor 
## 0.2559085
cor.test(icc_ev$ev_T1, icc_ev$ev_T3)
## 
##  Pearson's product-moment correlation
## 
## data:  icc_ev$ev_T1 and icc_ev$ev_T3
## t = 1.5154, df = 101, p-value = 0.1328
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.04573877  0.33302085
## sample estimates:
##       cor 
## 0.1491057
cor.test(icc_ev$ev_T1, icc_ev$ev_T4)
## 
##  Pearson's product-moment correlation
## 
## data:  icc_ev$ev_T1 and icc_ev$ev_T4
## t = 1.5295, df = 99, p-value = 0.1293
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.04483482  0.33735747
## sample estimates:
##       cor 
## 0.1519358
cor.test(icc_ev$ev_T2, icc_ev$ev_T3)
## 
##  Pearson's product-moment correlation
## 
## data:  icc_ev$ev_T2 and icc_ev$ev_T3
## t = 2.824, df = 86, p-value = 0.005894
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.08718673 0.47195651
## sample estimates:
##       cor 
## 0.2913095
cor.test(icc_ev$ev_T3, icc_ev$ev_T4)
## 
##  Pearson's product-moment correlation
## 
## data:  icc_ev$ev_T3 and icc_ev$ev_T4
## t = 2.5787, df = 93, p-value = 0.01149
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.05989464 0.43710559
## sample estimates:
##       cor 
## 0.2583194

（2）相関係数の算出

cordata <- data %>% dplyr::select(hsc_T1,hsc_T2,hsc_T3,hsc_T4,wb_T1,wb_T2,wb_T3,wb_T4,ev_T1,ev_T2,ev_T3,ev_T4,hsc_onemonth,wb_onemonth,ev_onemonth) %>% drop_na()
head(cordata)
names(cordata)
##  [1] "hsc_T1"       "hsc_T2"       "hsc_T3"       "hsc_T4"      
##  [5] "wb_T1"        "wb_T2"        "wb_T3"        "wb_T4"       
##  [9] "ev_T1"        "ev_T2"        "ev_T3"        "ev_T4"       
## [13] "hsc_onemonth" "wb_onemonth"  "ev_onemonth"
cormat <- round(cor(cordata),2)
head(cormat)
##        hsc_T1 hsc_T2 hsc_T3 hsc_T4 wb_T1 wb_T2 wb_T3 wb_T4 ev_T1 ev_T2
## hsc_T1   1.00   0.71   0.70   0.59  0.04 -0.02 -0.06  0.06 -0.12  0.04
## hsc_T2   0.71   1.00   0.74   0.77 -0.03 -0.09 -0.06  0.02 -0.06 -0.04
## hsc_T3   0.70   0.74   1.00   0.81 -0.06 -0.06 -0.16 -0.07  0.02 -0.01
## hsc_T4   0.59   0.77   0.81   1.00 -0.22 -0.15 -0.26 -0.21 -0.08 -0.08
## wb_T1    0.04  -0.03  -0.06  -0.22  1.00  0.67  0.69  0.66  0.29  0.24
## wb_T2   -0.02  -0.09  -0.06  -0.15  0.67  1.00  0.75  0.66  0.20  0.34
##        ev_T3 ev_T4 hsc_onemonth wb_onemonth ev_onemonth
## hsc_T1 -0.04  0.17         0.84        0.01        0.01
## hsc_T2 -0.04  0.29         0.91       -0.04        0.05
## hsc_T3 -0.17  0.22         0.91       -0.10        0.02
## hsc_T4 -0.03  0.25         0.90       -0.24        0.02
## wb_T1   0.12  0.13        -0.08        0.85        0.31
## wb_T2   0.09  0.13        -0.09        0.88        0.31
library(reshape2)
melted_cormat <- melt(cormat)
head(melted_cormat)
ggplot(data = melted_cormat, aes(Var2, Var1, fill = value))+
  geom_tile(color = "white")+
  scale_fill_gradient2(low = "blue", high = "red", mid = "white", 
                       midpoint = 0, limit = c(-1,1), space = "Lab", 
                       name="Pearson\nCorrelation") +
  theme_minimal()+ 
  theme(axis.text.x = element_text(angle = 45, vjust = 1, 
                                   size = 12, hjust = 1)) + coord_fixed()

（3）Roisman’s Approach（主効果モデルと交互作用モデルのF比を参照するため）

library(pequod)
## Loading required package: car
## Loading required package: carData
## 
## Attaching package: 'car'
## The following object is masked from 'package:psych':
## 
##     logit
## The following object is masked from 'package:dplyr':
## 
##     recode
## The following object is masked from 'package:purrr':
## 
##     some

3-0. 独立変数の中心化

data_c <- data %>% drop_na() %>% select_("hsc_T1", "hsc_T2", "hsc_T3", "hsc_T4", "wb_T1", "wb_T2", "wb_T3", "wb_T4", "ev_T1", "ev_T2", "ev_T3", "ev_T4", "hsc_onemonth", "wb_onemonth", "ev_onemonth") #na削除したうえで必要な変数抽出
data_c$hsc_T1_c <- data_c$hsc_T1 - mean(data_c$hsc_T1) #hsc_T1の中心化
data_c$hsc_T2_c <- data_c$hsc_T2 - mean(data_c$hsc_T2) #hsc_T2の中心化
data_c$hsc_T3_c <- data_c$hsc_T3 - mean(data_c$hsc_T3) #hsc_T3の中心化
data_c$hsc_T4_c <- data_c$hsc_T4 - mean(data_c$hsc_T4) #hsc_T4の中心化
data_c$ev_T1_c <- data_c$ev_T1 - mean(data_c$ev_T1) #ev_T1の中心化
data_c$ev_T2_c <- data_c$ev_T2 - mean(data_c$ev_T2) #ev_T2の中心化
data_c$ev_T3_c <- data_c$ev_T3 - mean(data_c$ev_T3) #ev_T3の中心化
data_c$ev_T4_c <- data_c$ev_T4 - mean(data_c$ev_T4) #ev_T4の中心化
data_c$hsc_onemonth_c  <- data_c$hsc_onemonth - mean(data_c$hsc_onemonth) #hsc_onemonthの中心化
data_c$ev_onemonth_c  <- data_c$ev_onemonth - mean(data_c$ev_onemonth) #ev_onemonthの中心化

3-1. 1時点目の分析

#pequodで分析版
model_t1 <- lmres(wb_T1 ~ ev_T1 + hsc_T1  + ev_T1:hsc_T1, centered = c("wb_T1", "ev_T1", "hsc_T1"), data = data) #交互作用の検討
summary(model_t1)
## Formula:
## wb_T1 ~ ev_T1 + hsc_T1 + ev_T1.XX.hsc_T1
## <environment: 0x000000001984e6d8>
## 
## Models
##          R     R^2   Adj. R^2    F     df1  df2  p.value   
## Model 0.3381 0.1143    0.0895 4.6048 3.0000  107  0.0045 **
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residuals
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -1.7422 -0.5602 -0.0017  0.0000  0.5958  1.7839 
## 
## Coefficients
##                 Estimate   StdErr  t.value   beta p.value    
## (Intercept)     -0.00098  0.07684 -0.01273         0.9899    
## ev_T1            0.17819  0.04874  3.65578 0.3392  0.0004 ***
## hsc_T1           0.04394  0.10982  0.40014 0.0376  0.6898    
## ev_T1.XX.hsc_T1  0.00611  0.06333  0.09655 0.0091  0.9233    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Collinearity
##                    VIF Tolerance
## ev_T1           1.0401    0.9614
## hsc_T1          1.0676    0.9367
## ev_T1.XX.hsc_T1 1.0684    0.9360
#通常のlmで分析版（ステップ1：主効果モデル）
model_t1s1 <- lm(data_c$wb_T1 ~ data_c$ev_T1_c + data_c$hsc_T1_c)
summary(model_t1s1)
## 
## Call:
## lm(formula = data_c$wb_T1 ~ data_c$ev_T1_c + data_c$hsc_T1_c)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1.88468 -0.53601 -0.03658  0.48434  1.73469 
## 
## Coefficients:
##                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)      2.84304    0.08714  32.627  < 2e-16 ***
## data_c$ev_T1_c   0.14728    0.05507   2.674  0.00917 ** 
## data_c$hsc_T1_c  0.08626    0.12166   0.709  0.48047    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.7745 on 76 degrees of freedom
## Multiple R-squared:  0.08777,    Adjusted R-squared:  0.06376 
## F-statistic: 3.656 on 2 and 76 DF,  p-value: 0.03048
AIC(model_t1s1)
## [1] 188.757
BIC(model_t1s1)
## [1] 198.2348
#通常のlmで分析版（ステップ2：交互作用モデル）
model_t1s2 <- lm(data_c$wb_T1 ~ data_c$ev_T1_c + data_c$hsc_T1_c + data_c$ev_T1_c:data_c$hsc_T1_c)
summary(model_t1s2)
## 
## Call:
## lm(formula = data_c$wb_T1 ~ data_c$ev_T1_c + data_c$hsc_T1_c + 
##     data_c$ev_T1_c:data_c$hsc_T1_c)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1.87631 -0.57551 -0.04676  0.51220  1.76186 
## 
## Coefficients:
##                                Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                     2.84925    0.08800  32.377   <2e-16 ***
## data_c$ev_T1_c                  0.14435    0.05547   2.602   0.0112 *  
## data_c$hsc_T1_c                 0.06433    0.12677   0.507   0.6133    
## data_c$ev_T1_c:data_c$hsc_T1_c  0.04666    0.07234   0.645   0.5209    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.7775 on 75 degrees of freedom
## Multiple R-squared:  0.0928, Adjusted R-squared:  0.05651 
## F-statistic: 2.557 on 3 and 75 DF,  p-value: 0.06147
AIC(model_t1s2)
## [1] 190.3199
BIC(model_t1s2)
## [1] 202.1672
anova(model_t1s1, model_t1s2) #R^2の増加量の検定

3-2. 2時点目の分析

#pequodで分析版
model_t2 <- lmres(wb_T2 ~ ev_T2 + hsc_T2  + ev_T2:hsc_T2, centered = c("wb_T2", "ev_T2", "hsc_T2"), data = data) #交互作用の検討
summary(model_t2)
## Formula:
## wb_T2 ~ ev_T2 + hsc_T2 + ev_T2.XX.hsc_T2
## <environment: 0x0000000019921d68>
## 
## Models
##         R    R^2   Adj. R^2   F    df1  df2  p.value   
## Model 0.377 0.142     0.113 4.909 3.000   89  0.0033 **
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residuals
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -1.5969 -0.5760  0.0040  0.0000  0.5055  2.2113 
## 
## Coefficients
##                 Estimate   StdErr  t.value    beta p.value   
## (Intercept)     -0.02452  0.08855 -0.27691         0.78249   
## ev_T2            0.16789  0.05420  3.09738  0.3073 0.00261 **
## hsc_T2          -0.04751  0.11207 -0.42387 -0.0419 0.67268   
## ev_T2.XX.hsc_T2  0.11027  0.06492  1.69840  0.1691 0.09293 . 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Collinearity
##                    VIF Tolerance
## ev_T2           1.0211    0.9794
## hsc_T2          1.0133    0.9869
## ev_T2.XX.hsc_T2 1.0287    0.9721
#通常のlmで分析版（ステップ1：主効果モデル）
model_t2s1 <- lm(data_c$wb_T2 ~ data_c$ev_T2_c + data_c$hsc_T2_c)
summary(model_t2s1)
## 
## Call:
## lm(formula = data_c$wb_T2 ~ data_c$ev_T2_c + data_c$hsc_T2_c)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -1.5797 -0.6433 -0.0366  0.6547  2.2020 
## 
## Coefficients:
##                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)      2.96203    0.09914  29.877  < 2e-16 ***
## data_c$ev_T2_c   0.19566    0.06145   3.184  0.00211 ** 
## data_c$hsc_T2_c -0.09549    0.13098  -0.729  0.46823    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8812 on 76 degrees of freedom
## Multiple R-squared:  0.125,  Adjusted R-squared:  0.102 
## F-statistic:  5.43 on 2 and 76 DF,  p-value: 0.006248
AIC(model_t2s1)
## [1] 209.149
BIC(model_t2s1)
## [1] 218.6268
#通常のlmで分析版（ステップ2：交互作用モデル）
model_t2s2 <- lm(data_c$wb_T2 ~ data_c$ev_T2_c + data_c$hsc_T2_c + data_c$ev_T2_c:data_c$hsc_T2_c)
summary(model_t2s2)
## 
## Call:
## lm(formula = data_c$wb_T2 ~ data_c$ev_T2_c + data_c$hsc_T2_c + 
##     data_c$ev_T2_c:data_c$hsc_T2_c)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1.60908 -0.56768 -0.02116  0.66961  2.19084 
## 
## Coefficients:
##                                Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                     2.96855    0.09814  30.250  < 2e-16 ***
## data_c$ev_T2_c                  0.16817    0.06304   2.668  0.00935 ** 
## data_c$hsc_T2_c                -0.07412    0.13020  -0.569  0.57086    
## data_c$ev_T2_c:data_c$hsc_T2_c  0.14174    0.08637   1.641  0.10495    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8715 on 75 degrees of freedom
## Multiple R-squared:  0.1554, Adjusted R-squared:  0.1216 
## F-statistic: 4.599 on 3 and 75 DF,  p-value: 0.005218
AIC(model_t2s2)
## [1] 208.3618
BIC(model_t2s2)
## [1] 220.209
anova(model_t2s1, model_t2s2) #R^2の増加量の検定
#### p<.10で交互作用が有意だったので単純傾斜検定
model_ss <- simpleSlope(model_t2, pred ="ev_T2", mod1 = "hsc_T2")
summary(model_ss) #High HSCだけ係数が有意 b = 0.26, p<.001
## 
## ** Estimated points of wb_T2  **
## 
##                     Low ev_T2 (-1 SD) High ev_T2 (+1 SD)
## Low hsc_T2 (-1 SD)            -0.1170             0.1507
## High hsc_T2 (+1 SD)           -0.4757             0.3747
## 
## 
## 
## ** Simple Slopes analysis ( df= 89 ) **
## 
##                     simple slope standard error t-value p.value    
## Low hsc_T2 (-1 SD)        0.0808         0.0793    1.02  0.3110    
## High hsc_T2 (+1 SD)       0.2568         0.0702    3.66  0.0004 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## 
## 
## ** Bauer & Curran 95% CI **
## 
##        lower CI upper CI
## hsc_T2  -0.4007   10.456
PlotSlope(model_ss)

#### RoS testをRoismanのアプリで行うために共分散を算出

#reg <- lm(data_c$wb_T2_c ~ data_c$ev_T2_c + data_c$hsc_T2_c + #data_c$ev_T2_c:data_c$hsc_T2_c)
#summary(reg)
#round(hccm(reg, type = "hc0"), digits = 3)

#必要なパラメタのメモ
#* Intercept (b0) = -0.024 →切片
#* Variable X (b1) = 0.31 →環境変数（独立変数）の回帰係数
#* Variable Z (b2) = -0.04 →感受性変数（調整変数）の回帰係数
#* Interaction XZ (b3) = 0.17 →交互作用項の回帰係数
#* Variance parameter b1 = 0.05^2 = 0.003 →たぶんstand.errorの2乗のことだと思う
#* Variance parameter b2 = 0.11^2 = 0.012 →たぶんstand.errorの2乗のことだと思う
#* Variance parameter b3 = 0.06^2 = 0.004 →たぶんstand.errorの2乗のことだと思う
#* Covariance parameters b1 b3 = -0.001
#* Covariance parameters b2 b3 = -0.001
#* Degress of freedom (df) = 75 →アプリの説明によればN - 独立変数の数k - 1で計算される（この場合、79 - 3 - 1 = 75）
RoS on X testing

RoS on X testing

3-3. 3時点目の分析

#pequodで分析版
model_t3 <- lmres(wb_T3 ~ ev_T3 + hsc_T3  + ev_T3:hsc_T3, centered = c("wb_T3", "ev_T3", "hsc_T3"), data = data) #交互作用の検討
summary(model_t3)
## Formula:
## wb_T3 ~ ev_T3 + hsc_T3 + ev_T3.XX.hsc_T3
## <environment: 0x00000000175b0a68>
## 
## Models
##         R    R^2   Adj. R^2   F    df1  df2  p.value   
## Model 0.372 0.139     0.112 5.261 3.000   98  0.0021 **
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residuals
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -2.5169 -0.5613  0.0126  0.0000  0.4938  2.0687 
## 
## Coefficients
##                 Estimate   StdErr  t.value    beta p.value   
## (Intercept)      0.01188  0.08902  0.13349          0.8941   
## ev_T3            0.17000  0.05800  2.93108  0.2875  0.0042 **
## hsc_T3          -0.16275  0.12174 -1.33685 -0.1276  0.1844   
## ev_T3.XX.hsc_T3  0.07700  0.06606  1.16561  0.1127  0.2466   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Collinearity
##                    VIF Tolerance
## ev_T3           1.0951    0.9132
## hsc_T3          1.0361    0.9652
## ev_T3.XX.hsc_T3 1.0631    0.9407
#通常のlmで分析版（ステップ1：主効果モデル）
model_t3s1 <- lm(data_c$wb_T3 ~ data_c$ev_T3_c + data_c$hsc_T3_c)
summary(model_t3s1)
## 
## Call:
## lm(formula = data_c$wb_T3 ~ data_c$ev_T3_c + data_c$hsc_T3_c)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -2.2932 -0.5946 -0.0384  0.5409  2.1203 
## 
## Coefficients:
##                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)      2.93418    0.10217  28.718   <2e-16 ***
## data_c$ev_T3_c   0.09873    0.06592   1.498    0.138    
## data_c$hsc_T3_c -0.15691    0.13561  -1.157    0.251    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.9081 on 76 degrees of freedom
## Multiple R-squared:  0.05346,    Adjusted R-squared:  0.02855 
## F-statistic: 2.146 on 2 and 76 DF,  p-value: 0.124
AIC(model_t3s1)
## [1] 213.9083
BIC(model_t3s1)
## [1] 223.386
#通常のlmで分析版（ステップ2：交互作用モデル）
model_t3s2 <- lm(data_c$wb_T3 ~ data_c$ev_T3_c + data_c$hsc_T3_c + data_c$ev_T3_c:data_c$hsc_T3_c)
summary(model_t3s2)
## 
## Call:
## lm(formula = data_c$wb_T3 ~ data_c$ev_T3_c + data_c$hsc_T3_c + 
##     data_c$ev_T3_c:data_c$hsc_T3_c)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -2.33862 -0.58016  0.02516  0.52491  2.07513 
## 
## Coefficients:
##                                Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                     2.94674    0.10347  28.480   <2e-16 ***
## data_c$ev_T3_c                  0.08734    0.06743   1.295    0.199    
## data_c$hsc_T3_c                -0.15430    0.13591  -1.135    0.260    
## data_c$ev_T3_c:data_c$hsc_T3_c  0.06166    0.07365   0.837    0.405    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.9099 on 75 degrees of freedom
## Multiple R-squared:  0.06222,    Adjusted R-squared:  0.02471 
## F-statistic: 1.659 on 3 and 75 DF,  p-value: 0.1831
AIC(model_t3s2)
## [1] 215.1735
BIC(model_t3s2)
## [1] 227.0208
anova(model_t3s1, model_t3s2) #R^2の増加量の検定

3-4. 4時点目の分析

#pequodで分析版
model_t4 <- lmres(wb_T4 ~ ev_T4 + hsc_T4  + ev_T4:hsc_T4, centered = c("wb_T4", "ev_T4", "hsc_T4"), data = data) #交互作用の検討
summary(model_t4)
## Formula:
## wb_T4 ~ ev_T4 + hsc_T4 + ev_T4.XX.hsc_T4
## <environment: 0x0000000017ec9420>
## 
## Models
##         R    R^2   Adj. R^2   F    df1  df2  p.value   
## Model 0.357 0.128     0.100 4.634 3.000   95  0.0045 **
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residuals
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -1.9067 -0.5602 -0.1458  0.0000  0.6003  2.3405 
## 
## Coefficients
##                 Estimate   StdErr  t.value    beta p.value   
## (Intercept)      0.05401  0.09761  0.55331         0.58135   
## ev_T4            0.19110  0.07035  2.71637  0.2642 0.00784 **
## hsc_T4          -0.36233  0.13034 -2.77984 -0.2692 0.00656 **
## ev_T4.XX.hsc_T4 -0.05298  0.08312 -0.63738 -0.0614 0.52541   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Collinearity
##                    VIF Tolerance
## ev_T4           1.0298    0.9711
## hsc_T4          1.0214    0.9790
## ev_T4.XX.hsc_T4 1.0092    0.9909
#通常のlmで分析版（ステップ1：主効果モデル）
model_t4s1 <- lm(data_c$wb_T4 ~ data_c$ev_T4_c + data_c$hsc_T4_c)
summary(model_t4s1)
## 
## Call:
## lm(formula = data_c$wb_T4 ~ data_c$ev_T4_c + data_c$hsc_T4_c)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -1.9455 -0.5644 -0.1442  0.6794  2.3338 
## 
## Coefficients:
##                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)      2.89114    0.11180  25.859   <2e-16 ***
## data_c$ev_T4_c   0.16951    0.07914   2.142   0.0354 *  
## data_c$hsc_T4_c -0.35649    0.14834  -2.403   0.0187 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.9937 on 76 degrees of freedom
## Multiple R-squared:  0.09866,    Adjusted R-squared:  0.07494 
## F-statistic:  4.16 on 2 and 76 DF,  p-value: 0.01931
AIC(model_t4s1)
## [1] 228.139
BIC(model_t4s1)
## [1] 237.6168
#通常のlmで分析版（ステップ2：交互作用モデル）
model_t4s2 <- lm(data_c$wb_T4 ~ data_c$ev_T4_c + data_c$hsc_T4_c + data_c$ev_T4_c:data_c$hsc_T4_c)
summary(model_t4s2)
## 
## Call:
## lm(formula = data_c$wb_T4 ~ data_c$ev_T4_c + data_c$hsc_T4_c + 
##     data_c$ev_T4_c:data_c$hsc_T4_c)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -1.9441 -0.5746 -0.1419  0.6479  2.3135 
## 
## Coefficients:
##                                Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                     2.90283    0.11553  25.126   <2e-16 ***
## data_c$ev_T4_c                  0.16597    0.07997   2.075   0.0414 *  
## data_c$hsc_T4_c                -0.36725    0.15115  -2.430   0.0175 *  
## data_c$ev_T4_c:data_c$hsc_T4_c -0.04147    0.09472  -0.438   0.6628    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.999 on 75 degrees of freedom
## Multiple R-squared:  0.101,  Adjusted R-squared:  0.065 
## F-statistic: 2.807 on 3 and 75 DF,  p-value: 0.0453
AIC(model_t4s2)
## [1] 229.9373
BIC(model_t4s2)
## [1] 241.7845
anova(model_t4s1, model_t4s2) #R^2の増加量の検定

3-5. 1ヵ月間の分析

#pequodで分析版
model_onemonth <- lmres(wb_onemonth ~ ev_onemonth + hsc_onemonth  + ev_onemonth:hsc_onemonth, centered = c("wb_onemonth", "ev_onemonth", "hsc_onemonth"), data = data) #交互作用の検討
summary(model_onemonth)
## Formula:
## wb_onemonth ~ ev_onemonth + hsc_onemonth + ev_onemonth.XX.hsc_onemonth
## <environment: 0x0000000015c1f058>
## 
## Models
##          R     R^2   Adj. R^2    F     df1  df2  p.value  
## Model 0.3610 0.1303    0.0955 3.7454 3.0000   75   0.015 *
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residuals
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -1.7044 -0.5392 -0.0975  0.0000  0.5028  1.7618 
## 
## Coefficients
##                             Estimate   StdErr  t.value    beta p.value   
## (Intercept)                 -0.01883  0.08661 -0.21743         0.82846   
## ev_onemonth                  0.24595  0.08966  2.74295  0.2978 0.00761 **
## hsc_onemonth                -0.17001  0.13083 -1.29944 -0.1421 0.19777   
## ev_onemonth.XX.hsc_onemonth  0.15957  0.12352  1.29192  0.1423 0.20035   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Collinearity
##                                VIF Tolerance
## ev_onemonth                 1.0161    0.9841
## hsc_onemonth                1.0309    0.9701
## ev_onemonth.XX.hsc_onemonth 1.0465    0.9555
#通常のlmで分析版（ステップ1：主効果モデル）
model_1ms1 <- lm(data_c$wb_onemonth ~ data_c$ev_onemonth_c + data_c$hsc_onemonth_c)
summary(model_1ms1)
## 
## Call:
## lm(formula = data_c$wb_onemonth ~ data_c$ev_onemonth_c + data_c$hsc_onemonth_c)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -1.6956 -0.4876 -0.1428  0.5073  1.7500 
## 
## Coefficients:
##                       Estimate Std. Error t value Pr(>|t|)    
## (Intercept)            2.90759    0.08694  33.445  < 2e-16 ***
## data_c$ev_onemonth_c   0.26015    0.08938   2.911  0.00473 ** 
## data_c$hsc_onemonth_c -0.14117    0.12948  -1.090  0.27902    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.7727 on 76 degrees of freedom
## Multiple R-squared:  0.1109, Adjusted R-squared:  0.08755 
## F-statistic: 4.742 on 2 and 76 DF,  p-value: 0.01146
AIC(model_1ms1)
## [1] 188.393
BIC(model_1ms1)
## [1] 197.8708
#通常のlmで分析版（ステップ2：交互作用モデル）
model_1ms2 <- lm(data_c$wb_onemonth ~ data_c$ev_onemonth_c + data_c$hsc_onemonth_c + data_c$ev_onemonth_c:data_c$hsc_onemonth_c)
summary(model_1ms2)
## 
## Call:
## lm(formula = data_c$wb_onemonth ~ data_c$ev_onemonth_c + data_c$hsc_onemonth_c + 
##     data_c$ev_onemonth_c:data_c$hsc_onemonth_c)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -1.70436 -0.53917 -0.09754  0.50279  1.76185 
## 
## Coefficients:
##                                            Estimate Std. Error t value
## (Intercept)                                 2.90456    0.08659  33.544
## data_c$ev_onemonth_c                        0.24856    0.08944   2.779
## data_c$hsc_onemonth_c                      -0.16780    0.13055  -1.285
## data_c$ev_onemonth_c:data_c$hsc_onemonth_c  0.15957    0.12352   1.292
##                                            Pr(>|t|)    
## (Intercept)                                 < 2e-16 ***
## data_c$ev_onemonth_c                        0.00689 ** 
## data_c$hsc_onemonth_c                       0.20264    
## data_c$ev_onemonth_c:data_c$hsc_onemonth_c  0.20035    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.7693 on 75 degrees of freedom
## Multiple R-squared:  0.1303, Adjusted R-squared:  0.09551 
## F-statistic: 3.745 on 3 and 75 DF,  p-value: 0.0145
AIC(model_1ms2)
## [1] 188.6542
BIC(model_1ms2)
## [1] 200.5014
anova(model_1ms1, model_1ms2) #R^2の増加量の検定

（4）時点ごとのWidaman’s Approach

library(soilphysics) #非線形モデルで準R2を算出するため使用
## Loading required package: rpanel
## Loading required package: tcltk
## Package `rpanel', version 1.1-4: type help(rpanel) for summary information
## 
## Attaching package: 'rpanel'
## The following object is masked from 'package:tidyr':
## 
##     population
## Loading required package: MASS
## 
## Attaching package: 'MASS'
## The following object is masked from 'package:plotly':
## 
##     select
## The following object is masked from 'package:dplyr':
## 
##     select
## Loading required package: tkrplot
## ---
## soilphysics version 3.1
##

4-1. 1時点目：弱い差次感受性

weak_diff_T1 <- nls(wb_T1 ~ B0 + B1*(ev_T1 - C) + B3*((ev_T1 - C)*hsc_T1), 
                 data = data,
                 start = list(B0 = 90, B1 = 0, C = 20, B3 = -1))
summary(weak_diff_T1) 
## 
## Formula: wb_T1 ~ B0 + B1 * (ev_T1 - C) + B3 * ((ev_T1 - C) * hsc_T1)
## 
## Parameters:
##     Estimate Std. Error t value Pr(>|t|)
## B0  1.452774  14.392736   0.101    0.920
## B1  0.147319   0.330826   0.445    0.657
## C  -6.395367  80.344866  -0.080    0.937
## B3  0.006115   0.063327   0.097    0.923
## 
## Residual standard error: 0.8036 on 107 degrees of freedom
## 
## Number of iterations to convergence: 2 
## Achieved convergence tolerance: 8.45e-06
##   (3 observations deleted due to missingness)
AIC(weak_diff_T1)
## [1] 272.4009
BIC(weak_diff_T1)
## [1] 285.9485
pred <- predict(weak_diff_T1) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(weak_diff_T1)
w <- weights(weak_diff_T1)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(weak_diff_T1)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.1143433
## 
## $adj.R.squared
## [1] 0.0895118

4-2. 1時点目：強い差次感受性

strong_diff_T1 <- nls(wb_T1 ~ B0 + 0*(ev_T1 - C) + B3*((ev_T1 - C)*hsc_T1),
                   data = data,
                   start = list(B0 = 90, C = 20, B3 = -1))
summary(strong_diff_T1)
## 
## Formula: wb_T1 ~ B0 + 0 * (ev_T1 - C) + B3 * ((ev_T1 - C) * hsc_T1)
## 
## Parameters:
##     Estimate Std. Error t value Pr(>|t|)    
## B0  2.574113   0.543269   4.738  6.6e-06 ***
## C  -0.159786   3.113120  -0.051 0.959160    
## B3  0.034014   0.009184   3.704 0.000337 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8007 on 108 degrees of freedom
## 
## Number of iterations to convergence: 2 
## Achieved convergence tolerance: 3.201e-06
##   (3 observations deleted due to missingness)
AIC(strong_diff_T1)
## [1] 270.6064
BIC(strong_diff_T1)
## [1] 281.4445
pred <- predict(strong_diff_T1) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(strong_diff_T1)
w <- weights(strong_diff_T1)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(strong_diff_T1)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.1127019
## 
## $adj.R.squared
## [1] 0.09627048

4-3. 1時点目：弱い素因ストレス

weak_diathesis_T1 <- nls(wb_T1 ~ B0 + B1*(ev_T1 + 3) + B3*((ev_T1 + 3)*hsc_T1), #+3は環境変数の最大値(C on X)
                      data = data,
                      start = list(B0 = 90, B1 = 0, B3 = -1)) #Cの初期値は設定不要
summary(weak_diathesis_T1)
## 
## Formula: wb_T1 ~ B0 + B1 * (ev_T1 + 3) + B3 * ((ev_T1 + 3) * hsc_T1)
## 
## Parameters:
##    Estimate Std. Error t value Pr(>|t|)    
## B0  2.06101    0.19591  10.520   <2e-16 ***
## B1  0.12509    0.12615   0.992    0.324    
## B3  0.01038    0.02366   0.439    0.662    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.7999 on 108 degrees of freedom
## 
## Number of iterations to convergence: 1 
## Achieved convergence tolerance: 4.062e-08
##   (3 observations deleted due to missingness)
AIC(weak_diathesis_T1)
## [1] 270.4063
BIC(weak_diathesis_T1)
## [1] 281.2445
pred <- predict(weak_diathesis_T1) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(weak_diathesis_T1)
w <- weights(weak_diathesis_T1)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(weak_diathesis_T1)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.1142995
## 
## $adj.R.squared
## [1] 0.09789763

4-4. 1時点目：強い素因ストレス

strong_diathesis_T1 <- nls(wb_T1 ~ B0 + 0*(ev_T1 + 3) + B3*((ev_T1 + 3)*hsc_T1),
                        data = data,
                        start = list(B0 = 90, B3 = -1))
summary(strong_diathesis_T1)
## 
## Formula: wb_T1 ~ B0 + 0 * (ev_T1 + 3) + B3 * ((ev_T1 + 3) * hsc_T1)
## 
## Parameters:
##    Estimate Std. Error t value Pr(>|t|)    
## B0 2.121405   0.186187  11.394  < 2e-16 ***
## B3 0.032112   0.008921   3.599 0.000481 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.7999 on 109 degrees of freedom
## 
## Number of iterations to convergence: 1 
## Achieved convergence tolerance: 4.515e-08
##   (3 observations deleted due to missingness)
AIC(strong_diathesis_T1)
## [1] 269.4123
BIC(strong_diathesis_T1)
## [1] 277.5409
pred <- predict(strong_diathesis_T1) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(strong_diathesis_T1)
w <- weights(strong_diathesis_T1)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(strong_diathesis_T1)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.106236
## 
## $adj.R.squared
## [1] 0.09803635

4-5. 1時点目：弱いヴァンテージ感受性

weak_vs_T1 <- nls(wb_T1 ~ B0 + B1*(ev_T1 - 3) + B3*((ev_T1 - 3)*hsc_T1), #-3は環境変数の最小値（C on X）
               data = data,
               start = list(B0 = 90, B1 = 0, B3 = -1))
summary(weak_vs_T1)
## 
## Formula: wb_T1 ~ B0 + B1 * (ev_T1 - 3) + B3 * ((ev_T1 - 3) * hsc_T1)
## 
## Parameters:
##    Estimate Std. Error t value Pr(>|t|)    
## B0  3.12607    0.13037  23.978   <2e-16 ***
## B1  0.23339    0.23091   1.011    0.314    
## B3 -0.01082    0.04288  -0.252    0.801    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8004 on 108 degrees of freedom
## 
## Number of iterations to convergence: 1 
## Achieved convergence tolerance: 8.635e-08
##   (3 observations deleted due to missingness)
AIC(weak_vs_T1)
## [1] 270.5387
BIC(weak_vs_T1)
## [1] 281.3769
pred <- predict(weak_vs_T1) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(weak_vs_T1)
w <- weights(weak_vs_T1)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(weak_vs_T1)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.1132424
## 
## $adj.R.squared
## [1] 0.09682095

4-6. 1時点目：強いヴァンテージ感受性

strong_vs_T1 <- nls(wb_T1 ~ B0 + 0*(ev_T1 - 3) + B3*((ev_T1 - 3)*hsc_T1),
                 data = data,
                 start = list(B0 = 90, B3 = -1))
summary(strong_vs_T1)
## 
## Formula: wb_T1 ~ B0 + 0 * (ev_T1 - 3) + B3 * ((ev_T1 - 3) * hsc_T1)
## 
## Parameters:
##    Estimate Std. Error t value Pr(>|t|)    
## B0 3.090684   0.125596  24.608  < 2e-16 ***
## B3 0.031592   0.008841   3.573 0.000527 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8005 on 109 degrees of freedom
## 
## Number of iterations to convergence: 1 
## Achieved convergence tolerance: 8.133e-08
##   (3 observations deleted due to missingness)
AIC(strong_vs_T1)
## [1] 269.5838
BIC(strong_vs_T1)
## [1] 277.7124
pred <- predict(strong_vs_T1) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(strong_vs_T1)
w <- weights(strong_vs_T1)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(strong_vs_T1)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.1048542
## 
## $adj.R.squared
## [1] 0.09664187

4-7. 2時点目：弱い差次感受性

weak_diff_T2 <- nls(wb_T2 ~ B0 + B1*(ev_T2 - C) + B3*((ev_T2 - C)*hsc_T2), 
                    data = data,
                    start = list(B0 = 90, B1 = 0, C = 20, B3 = -1))
summary(weak_diff_T2) 
## 
## Formula: wb_T2 ~ B0 + B1 * (ev_T2 - C) + B3 * ((ev_T2 - C) * hsc_T2)
## 
## Parameters:
##    Estimate Std. Error t value Pr(>|t|)    
## B0  3.01952    0.20052  15.058   <2e-16 ***
## B1 -0.38863    0.33905  -1.146   0.2548    
## C   1.15712    1.07134   1.080   0.2830    
## B3  0.11027    0.06492   1.698   0.0929 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.852 on 89 degrees of freedom
## 
## Number of iterations to convergence: 2 
## Achieved convergence tolerance: 2.625e-06
##   (21 observations deleted due to missingness)
AIC(weak_diff_T2)
## [1] 240.0366
BIC(weak_diff_T2)
## [1] 252.6996
pred <- predict(weak_diff_T2) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(weak_diff_T2)
w <- weights(weak_diff_T2)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(weak_diff_T2)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.1419812
## 
## $adj.R.squared
## [1] 0.1130592

4-8. 2時点目：強い差次感受性

strong_diff_T2 <- nls(wb_T2 ~ B0 + 0*(ev_T2 - C) + B3*((ev_T2 - C)*hsc_T2),
                      data = data,
                      start = list(B0 = 90, C = 20, B3 = -1))
summary(strong_diff_T2)
## 
## Formula: wb_T2 ~ B0 + 0 * (ev_T2 - C) + B3 * ((ev_T2 - C) * hsc_T2)
## 
## Parameters:
##    Estimate Std. Error t value Pr(>|t|)    
## B0  3.23686    0.57242   5.655 1.82e-07 ***
## C   2.32133    3.10572   0.747 0.456748    
## B3  0.03679    0.01031   3.569 0.000577 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8535 on 90 degrees of freedom
## 
## Number of iterations to convergence: 2 
## Achieved convergence tolerance: 1.361e-07
##   (21 observations deleted due to missingness)
AIC(strong_diff_T2)
## [1] 239.3994
BIC(strong_diff_T2)
## [1] 249.5298
pred <- predict(strong_diff_T2) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(strong_diff_T2)
w <- weights(strong_diff_T2)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(strong_diff_T2)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.1293146
## 
## $adj.R.squared
## [1] 0.109966

4-9. 2時点目：弱い素因ストレス

weak_diathesis_T2 <- nls(wb_T2 ~ B0 + B1*(ev_T2 + 3) + B3*((ev_T2 + 3)*hsc_T2), #+3は環境変数の最大値(C on X)
                         data = data,
                         start = list(B0 = 90, B1 = 0, B3 = -1)) #Cの初期値は設定不要
summary(weak_diathesis_T2)
## 
## Formula: wb_T2 ~ B0 + B1 * (ev_T2 + 3) + B3 * ((ev_T2 + 3) * hsc_T2)
## 
## Parameters:
##    Estimate Std. Error t value Pr(>|t|)    
## B0 2.260343   0.223576  10.110   <2e-16 ***
## B1 0.152608   0.154264   0.989    0.325    
## B3 0.005785   0.028574   0.202    0.840    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8623 on 90 degrees of freedom
## 
## Number of iterations to convergence: 1 
## Achieved convergence tolerance: 1.384e-07
##   (21 observations deleted due to missingness)
AIC(weak_diathesis_T2)
## [1] 241.3154
BIC(weak_diathesis_T2)
## [1] 251.4458
pred <- predict(weak_diathesis_T2) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(weak_diathesis_T2)
w <- weights(weak_diathesis_T2)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(weak_diathesis_T2)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.1111912
## 
## $adj.R.squared
## [1] 0.09143991

4-10. 2時点目：強い素因ストレス

strong_diathesis_T2 <- nls(wb_T2 ~ B0 + 0*(ev_T2 + 3) + B3*((ev_T2 + 3)*hsc_T2),
                           data = data,
                           start = list(B0 = 90, B3 = -1))
summary(strong_diathesis_T2)
## 
## Formula: wb_T2 ~ B0 + 0 * (ev_T2 + 3) + B3 * ((ev_T2 + 3) * hsc_T2)
## 
## Parameters:
##    Estimate Std. Error t value Pr(>|t|)    
## B0  2.33356    0.21094  11.062  < 2e-16 ***
## B3  0.03224    0.01006   3.207  0.00185 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8622 on 91 degrees of freedom
## 
## Number of iterations to convergence: 1 
## Achieved convergence tolerance: 1.172e-07
##   (21 observations deleted due to missingness)
AIC(strong_diathesis_T2)
## [1] 240.3212
BIC(strong_diathesis_T2)
## [1] 247.919
pred <- predict(strong_diathesis_T2) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(strong_diathesis_T2)
w <- weights(strong_diathesis_T2)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(strong_diathesis_T2)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.1015265
## 
## $adj.R.squared
## [1] 0.09165313

4-11. 2時点目：弱いヴァンテージ感受性

weak_vs_T2 <- nls(wb_T2 ~ B0 + B1*(ev_T2 - 3) + B3*((ev_T2 - 3)*hsc_T2), #-3は環境変数の最小値（C on X）
                  data = data,
                  start = list(B0 = 90, B1 = 0, B3 = -1))
summary(weak_vs_T2)
## 
## Formula: wb_T2 ~ B0 + B1 * (ev_T2 - 3) + B3 * ((ev_T2 - 3) * hsc_T2)
## 
## Parameters:
##    Estimate Std. Error t value Pr(>|t|)    
## B0  3.33441    0.14904  22.373   <2e-16 ***
## B1 -0.10358    0.20259  -0.511    0.610    
## B3  0.05461    0.03737   1.461    0.147    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8524 on 90 degrees of freedom
## 
## Number of iterations to convergence: 1 
## Achieved convergence tolerance: 1.294e-07
##   (21 observations deleted due to missingness)
AIC(weak_vs_T2)
## [1] 239.1776
BIC(weak_vs_T2)
## [1] 249.308
pred <- predict(weak_vs_T2) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(weak_vs_T2)
w <- weights(weak_vs_T2)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(weak_vs_T2)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.131389
## 
## $adj.R.squared
## [1] 0.1120866

4-12. 2時点目：強いヴァンテージ感受性

strong_vs_T2 <- nls(wb_T2 ~ B0 + 0*(ev_T2 - 3) + B3*((ev_T2 - 3)*hsc_T2),
                    data = data,
                    start = list(B0 = 90, B3 = -1))
summary(strong_vs_T2)
## 
## Formula: wb_T2 ~ B0 + 0 * (ev_T2 - 3) + B3 * ((ev_T2 - 3) * hsc_T2)
## 
## Parameters:
##    Estimate Std. Error t value Pr(>|t|)    
## B0 3.356185   0.142247  23.594  < 2e-16 ***
## B3 0.036180   0.009861   3.669  0.00041 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.849 on 91 degrees of freedom
## 
## Number of iterations to convergence: 1 
## Achieved convergence tolerance: 7.884e-08
##   (21 observations deleted due to missingness)
AIC(strong_vs_T2)
## [1] 237.4473
BIC(strong_vs_T2)
## [1] 245.0451
pred <- predict(strong_vs_T2) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(strong_vs_T2)
w <- weights(strong_vs_T2)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(strong_vs_T2)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.1288662
## 
## $adj.R.squared
## [1] 0.1192933

4-13. 3時点目：弱い差次感受性

weak_diff_T3 <- nls(wb_T3 ~ B0 + B1*(ev_T3 - C) + B3*((ev_T3 - C)*hsc_T3), 
                    data = data,
                    start = list(B0 = 90, B1 = 0, C = 20, B3 = -1))
summary(weak_diff_T3) 
## 
## Formula: wb_T3 ~ B0 + B1 * (ev_T3 - C) + B3 * ((ev_T3 - C) * hsc_T3)
## 
## Parameters:
##    Estimate Std. Error t value Pr(>|t|)    
## B0  3.27024    0.41959   7.794 6.96e-12 ***
## B1 -0.23560    0.36636  -0.643    0.522    
## C   2.76894    2.32002   1.193    0.236    
## B3  0.07700    0.06606   1.166    0.247    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8877 on 98 degrees of freedom
## 
## Number of iterations to convergence: 2 
## Achieved convergence tolerance: 5.931e-07
##   (12 observations deleted due to missingness)
AIC(weak_diff_T3)
## [1] 271.08
BIC(weak_diff_T3)
## [1] 284.2049
pred <- predict(weak_diff_T3) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(weak_diff_T3)
w <- weights(weak_diff_T3)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(weak_diff_T3)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.1387073
## 
## $adj.R.squared
## [1] 0.1123412

4-14. 3時点目：強い差次感受性

strong_diff_T3 <- nls(wb_T3 ~ B0 + 0*(ev_T3 - C) + B3*((ev_T3 - C)*hsc_T3),
                      data = data,
                      start = list(B0 = 90, C = 20, B3 = -1))
summary(strong_diff_T3)
## 
## Formula: wb_T3 ~ B0 + 0 * (ev_T3 - C) + B3 * ((ev_T3 - C) * hsc_T3)
## 
## Parameters:
##    Estimate Std. Error t value Pr(>|t|)    
## B0  3.71943    0.64349   5.780 8.69e-08 ***
## C   5.08683    3.86721   1.315 0.191422    
## B3  0.03502    0.01012   3.462 0.000793 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8851 on 99 degrees of freedom
## 
## Number of iterations to convergence: 2 
## Achieved convergence tolerance: 4.928e-07
##   (12 observations deleted due to missingness)
AIC(strong_diff_T3)
## [1] 269.5095
BIC(strong_diff_T3)
## [1] 280.0094
pred <- predict(strong_diff_T3) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(strong_diff_T3)
w <- weights(strong_diff_T3)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(strong_diff_T3)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.1350728
## 
## $adj.R.squared
## [1] 0.1175995

4-15. 3時点目：弱い素因ストレス

weak_diathesis_T3 <- nls(wb_T3 ~ B0 + B1*(ev_T3 + 3) + B3*((ev_T3 + 3)*hsc_T3), #+3は環境変数の最大値(C on X)
                         data = data,
                         start = list(B0 = 90, B1 = 0, B3 = -1)) #Cの初期値は設定不要
summary(weak_diathesis_T3)
## 
## Formula: wb_T3 ~ B0 + B1 * (ev_T3 + 3) + B3 * ((ev_T3 + 3) * hsc_T3)
## 
## Parameters:
##    Estimate Std. Error t value Pr(>|t|)    
## B0  2.16989    0.22446   9.667 5.82e-16 ***
## B1  0.29155    0.16057   1.816   0.0724 .  
## B3 -0.01795    0.02908  -0.617   0.5385    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8946 on 99 degrees of freedom
## 
## Number of iterations to convergence: 1 
## Achieved convergence tolerance: 8.778e-08
##   (12 observations deleted due to missingness)
AIC(weak_diathesis_T3)
## [1] 271.7034
BIC(weak_diathesis_T3)
## [1] 282.2033
pred <- predict(weak_diathesis_T3) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(weak_diathesis_T3)
w <- weights(weak_diathesis_T3)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(weak_diathesis_T3)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.116268
## 
## $adj.R.squared
## [1] 0.09841479

4-16. 3時点目：強い素因ストレス

strong_diathesis_T3 <- nls(wb_T3 ~ B0 + 0*(ev_T3 + 3) + B3*((ev_T3 + 3)*hsc_T3),
                           data = data,
                           start = list(B0 = 90, B3 = -1))
summary(strong_diathesis_T3)
## 
## Formula: wb_T3 ~ B0 + 0 * (ev_T3 + 3) + B3 * ((ev_T3 + 3) * hsc_T3)
## 
## Parameters:
##    Estimate Std. Error t value Pr(>|t|)    
## B0  2.29177    0.21663  10.579  < 2e-16 ***
## B3  0.03155    0.01023   3.084  0.00264 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.9048 on 100 degrees of freedom
## 
## Number of iterations to convergence: 1 
## Achieved convergence tolerance: 6.82e-08
##   (12 observations deleted due to missingness)
AIC(strong_diathesis_T3)
## [1] 273.0448
BIC(strong_diathesis_T3)
## [1] 280.9197
pred <- predict(strong_diathesis_T3) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(strong_diathesis_T3)
w <- weights(strong_diathesis_T3)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(strong_diathesis_T3)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.08683896
## 
## $adj.R.squared
## [1] 0.07770735

4-17. 3時点目：弱いヴァンテージ感受性

weak_vs_T3 <- nls(wb_T3 ~ B0 + B1*(ev_T3 - 3) + B3*((ev_T3 - 3)*hsc_T3), #-3は環境変数の最小値（C on X）
                  data = data,
                  start = list(B0 = 90, B1 = 0, B3 = -1))
summary(weak_vs_T3)
## 
## Formula: wb_T3 ~ B0 + B1 * (ev_T3 - 3) + B3 * ((ev_T3 - 3) * hsc_T3)
## 
## Parameters:
##    Estimate Std. Error t value Pr(>|t|)    
## B0  3.30962    0.15706  21.072   <2e-16 ***
## B1 -0.21011    0.24384  -0.862   0.3909    
## B3  0.07224    0.04198   1.721   0.0884 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8832 on 99 degrees of freedom
## 
## Number of iterations to convergence: 1 
## Achieved convergence tolerance: 6.3e-08
##   (12 observations deleted due to missingness)
AIC(weak_vs_T3)
## [1] 269.0891
BIC(weak_vs_T3)
## [1] 279.589
pred <- predict(weak_vs_T3) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(weak_vs_T3)
w <- weights(weak_vs_T3)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(weak_vs_T3)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.1386304
## 
## $adj.R.squared
## [1] 0.1212289

4-18. 3時点目：強いヴァンテージ感受性

strong_vs_T3 <- nls(wb_T3 ~ B0 + 0*(ev_T3 - 3) + B3*((ev_T3 - 3)*hsc_T3),
                    data = data,
                    start = list(B0 = 90, B3 = -1))
summary(strong_vs_T3)
## 
## Formula: wb_T3 ~ B0 + 0 * (ev_T3 - 3) + B3 * ((ev_T3 - 3) * hsc_T3)
## 
## Parameters:
##    Estimate Std. Error t value Pr(>|t|)    
## B0 3.358310   0.146356  22.946  < 2e-16 ***
## B3 0.037006   0.009482   3.903 0.000173 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8821 on 100 degrees of freedom
## 
## Number of iterations to convergence: 1 
## Achieved convergence tolerance: 5.567e-08
##   (12 observations deleted due to missingness)
AIC(strong_vs_T3)
## [1] 267.8513
BIC(strong_vs_T3)
## [1] 275.7262
pred <- predict(strong_vs_T3) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(strong_vs_T3)
w <- weights(strong_vs_T3)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(strong_vs_T3)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.1321703
## 
## $adj.R.squared
## [1] 0.123492

4-19. 4時点目：弱い差次感受性

weak_diff_T4 <- nls(wb_T4 ~ B0 + B1*(ev_T4 - C) + B3*((ev_T4 - C)*hsc_T4), 
                    data = data,
                    start = list(B0 = 90, B1 = 0, C = 20, B3 = -1))
summary(weak_diff_T4) 
## 
## Formula: wb_T4 ~ B0 + B1 * (ev_T4 - C) + B3 * ((ev_T4 - C) * hsc_T4)
## 
## Parameters:
##    Estimate Std. Error t value Pr(>|t|)
## B0  1.61131    2.21956   0.726    0.470
## B1  0.46381    0.42723   1.086    0.280
## C  -5.95743   10.97203  -0.543    0.588
## B3 -0.05298    0.08312  -0.637    0.525
## 
## Residual standard error: 0.961 on 95 degrees of freedom
## 
## Number of iterations to convergence: 2 
## Achieved convergence tolerance: 5.251e-06
##   (15 observations deleted due to missingness)
AIC(weak_diff_T4)
## [1] 278.9991
BIC(weak_diff_T4)
## [1] 291.9747
pred <- predict(weak_diff_T4) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(weak_diff_T4)
w <- weights(weak_diff_T4)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(weak_diff_T4)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.1276512
## 
## $adj.R.squared
## [1] 0.1001033

4-20. 4時点目：強い差次感受性

strong_diff_T4 <- nls(wb_T4 ~ B0 + 0*(ev_T4 - C) + B3*((ev_T4 - C)*hsc_T4),
                      data = data,
                      start = list(B0 = 90, C = 20, B3 = -1))
summary(strong_diff_T4)
## 
## Formula: wb_T4 ~ B0 + 0 * (ev_T4 - C) + B3 * ((ev_T4 - C) * hsc_T4)
## 
## Parameters:
##    Estimate Std. Error t value Pr(>|t|)    
## B0  4.74160    0.68412   6.931 4.81e-10 ***
## C  10.78444    4.83217   2.232  0.02795 *  
## B3  0.03604    0.01364   2.641  0.00964 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.9619 on 96 degrees of freedom
## 
## Number of iterations to convergence: 2 
## Achieved convergence tolerance: 3.804e-08
##   (15 observations deleted due to missingness)
AIC(strong_diff_T4)
## [1] 278.2198
BIC(strong_diff_T4)
## [1] 288.6003
pred <- predict(strong_diff_T4) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(strong_diff_T4)
w <- weights(strong_diff_T4)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(strong_diff_T4)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.1168286
## 
## $adj.R.squared
## [1] 0.09842921

4-21. 4時点目：弱い素因ストレス

weak_diathesis_T4 <- nls(wb_T4 ~ B0 + B1*(ev_T4 + 3) + B3*((ev_T4 + 3)*hsc_T4), #+3は環境変数の最大値(C on X)
                         data = data,
                         start = list(B0 = 90, B1 = 0, B3 = -1)) #Cの初期値は設定不要
summary(weak_diathesis_T4)
## 
## Formula: wb_T4 ~ B0 + B1 * (ev_T4 + 3) + B3 * ((ev_T4 + 3) * hsc_T4)
## 
## Parameters:
##    Estimate Std. Error t value Pr(>|t|)    
## B0  2.19774    0.28466   7.720  1.1e-11 ***
## B1  0.63883    0.18101   3.529 0.000642 ***
## B3 -0.08784    0.03117  -2.818 0.005860 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.9571 on 96 degrees of freedom
## 
## Number of iterations to convergence: 1 
## Achieved convergence tolerance: 5.765e-08
##   (15 observations deleted due to missingness)
AIC(weak_diathesis_T4)
## [1] 277.2124
BIC(weak_diathesis_T4)
## [1] 287.5929
pred <- predict(weak_diathesis_T4) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(weak_diathesis_T4)
w <- weights(weak_diathesis_T4)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(weak_diathesis_T4)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.1257695
## 
## $adj.R.squared
## [1] 0.1075564

4-22. 4時点目：強い素因ストレス

strong_diathesis_T4 <- nls(wb_T4 ~ B0 + 0*(ev_T4 + 3) + B3*((ev_T4 + 3)*hsc_T4),
                           data = data,
                           start = list(B0 = 90, B3 = -1))
summary(strong_diathesis_T4)
## 
## Formula: wb_T4 ~ B0 + 0 * (ev_T4 + 3) + B3 * ((ev_T4 + 3) * hsc_T4)
## 
## Parameters:
##    Estimate Std. Error t value Pr(>|t|)    
## B0  2.61026    0.27446   9.511 1.53e-15 ***
## B3  0.01384    0.01257   1.101    0.274    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.012 on 97 degrees of freedom
## 
## Number of iterations to convergence: 1 
## Achieved convergence tolerance: 7.469e-08
##   (15 observations deleted due to missingness)
AIC(strong_diathesis_T4)
## [1] 287.2897
BIC(strong_diathesis_T4)
## [1] 295.0751
pred <- predict(strong_diathesis_T4) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(strong_diathesis_T4)
w <- weights(strong_diathesis_T4)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(strong_diathesis_T4)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.01234146
## 
## $adj.R.squared
## [1] 0.002159416

4-23. 4時点目：弱いヴァンテージ感受性

weak_vs_T4 <- nls(wb_T4 ~ B0 + B1*(ev_T4 - 3) + B3*((ev_T4 - 3)*hsc_T4), #-3は環境変数の最小値（C on X）
                  data = data,
                  start = list(B0 = 90, B1 = 0, B3 = -1))
summary(weak_vs_T4)
## 
## Formula: wb_T4 ~ B0 + B1 * (ev_T4 - 3) + B3 * ((ev_T4 - 3) * hsc_T4)
## 
## Parameters:
##    Estimate Std. Error t value Pr(>|t|)    
## B0  3.28953    0.18107  18.167   <2e-16 ***
## B1 -0.28044    0.25524  -1.099   0.2746    
## B3  0.09128    0.05001   1.825   0.0711 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.979 on 96 degrees of freedom
## 
## Number of iterations to convergence: 1 
## Achieved convergence tolerance: 5.431e-08
##   (15 observations deleted due to missingness)
AIC(weak_vs_T4)
## [1] 281.7058
BIC(weak_vs_T4)
## [1] 292.0863
pred <- predict(weak_vs_T4) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(weak_vs_T4)
w <- weights(weak_vs_T4)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(weak_vs_T4)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.08517603
## 
## $adj.R.squared
## [1] 0.0661172

4-24. 4時点目：強いヴァンテージ感受性

strong_vs_T4 <- nls(wb_T4 ~ B0 + 0*(ev_T4 - 3) + B3*((ev_T4 - 3)*hsc_T4),
                    data = data,
                    start = list(B0 = 90, B3 = -1))
summary(strong_vs_T4)
## 
## Formula: wb_T4 ~ B0 + 0 * (ev_T4 - 3) + B3 * ((ev_T4 - 3) * hsc_T4)
## 
## Parameters:
##    Estimate Std. Error t value Pr(>|t|)    
## B0  3.31028    0.18028  18.362  < 2e-16 ***
## B3  0.03848    0.01385   2.777  0.00658 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.9801 on 97 degrees of freedom
## 
## Number of iterations to convergence: 1 
## Achieved convergence tolerance: 3.238e-08
##   (15 observations deleted due to missingness)
AIC(strong_vs_T4)
## [1] 280.943
BIC(strong_vs_T4)
## [1] 288.7284
pred <- predict(strong_vs_T4) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(strong_vs_T4)
w <- weights(strong_vs_T4)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(strong_vs_T4)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.0736715
## 
## $adj.R.squared
## [1] 0.06412173

（5）1か月間のWidaman’s Approach

5-1. 弱い差次感受性

weak_diff_om <- nls(wb_onemonth ~ B0 + B1*(ev_onemonth - C) + B3*((ev_onemonth - C)*hsc_onemonth), 
                    data = data,
                    start = list(B0 = 90, B1 = 0, C = 20, B3 = -1))
summary(weak_diff_om) 
## 
## Formula: wb_onemonth ~ B0 + B1 * (ev_onemonth - C) + B3 * ((ev_onemonth - 
##     C) * hsc_onemonth)
## 
## Parameters:
##    Estimate Std. Error t value Pr(>|t|)    
## B0   3.1659     0.3013  10.507   <2e-16 ***
## B1  -0.5786     0.6553  -0.883   0.3801    
## C    1.9091     1.0590   1.803   0.0755 .  
## B3   0.1596     0.1235   1.292   0.2004    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.7693 on 75 degrees of freedom
## 
## Number of iterations to convergence: 2 
## Achieved convergence tolerance: 8.697e-07
##   (35 observations deleted due to missingness)
AIC(weak_diff_om)
## [1] 188.6542
BIC(weak_diff_om)
## [1] 200.5014
pred <- predict(weak_diff_om) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(weak_diff_om)
w <- weights(weak_diff_om)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(weak_diff_om)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.1302958
## 
## $adj.R.squared
## [1] 0.09550759

5-2. 強い差次感受性

strong_diff_om <- nls(wb_onemonth ~ B0 + 0*(ev_onemonth - C) + B3*((ev_onemonth - C)*hsc_onemonth),
                      data = data,
                      start = list(B0 = 90, C = 20, B3 = -1))
summary(strong_diff_om)
## 
## Formula: wb_onemonth ~ B0 + 0 * (ev_onemonth - C) + B3 * ((ev_onemonth - 
##     C) * hsc_onemonth)
## 
## Parameters:
##    Estimate Std. Error t value Pr(>|t|)    
## B0  3.68529    0.67339   5.473 5.47e-07 ***
## C   3.77317    2.62898   1.435  0.15533    
## B3  0.05152    0.01675   3.076  0.00291 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.7682 on 76 degrees of freedom
## 
## Number of iterations to convergence: 2 
## Achieved convergence tolerance: 4.179e-07
##   (35 observations deleted due to missingness)
AIC(strong_diff_om)
## [1] 187.4712
BIC(strong_diff_om)
## [1] 196.9489
pred <- predict(strong_diff_om) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(strong_diff_om)
w <- weights(strong_diff_om)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(strong_diff_om)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.1212552
## 
## $adj.R.squared
## [1] 0.09813036

5-3. 弱い素因ストレス

weak_diathesis_om <- nls(wb_onemonth ~ B0 + B1*(ev_onemonth + 3) + B3*((ev_onemonth + 3)*hsc_onemonth), #+3は環境変数の最大値(C on X)
                         data = data,
                         start = list(B0 = 90, B1 = 0, B3 = -1)) #Cの初期値は設定不要
summary(weak_diathesis_om)
## 
## Formula: wb_onemonth ~ B0 + B1 * (ev_onemonth + 3) + B3 * ((ev_onemonth + 
##     3) * hsc_onemonth)
## 
## Parameters:
##    Estimate Std. Error t value Pr(>|t|)    
## B0  1.90191    0.35741   5.321 1.01e-06 ***
## B1  0.37906    0.18951   2.000   0.0491 *  
## B3 -0.02281    0.03128  -0.729   0.4680    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.776 on 76 degrees of freedom
## 
## Number of iterations to convergence: 1 
## Achieved convergence tolerance: 1.535e-07
##   (35 observations deleted due to missingness)
AIC(weak_diathesis_om)
## [1] 189.0681
BIC(weak_diathesis_om)
## [1] 198.5458
pred <- predict(weak_diathesis_om) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(weak_diathesis_om)
w <- weights(weak_diathesis_om)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(weak_diathesis_om)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.1033116
## 
## $adj.R.squared
## [1] 0.07971451

5-4. 強い素因ストレス

strong_diathesis_om <- nls(wb_onemonth ~ B0 + 0*(ev_onemonth + 3) + B3*((ev_onemonth + 3)*hsc_onemonth),
                           data = data,
                           start = list(B0 = 90, B3 = -1))
summary(strong_diathesis_om)
## 
## Formula: wb_onemonth ~ B0 + 0 * (ev_onemonth + 3) + B3 * ((ev_onemonth + 
##     3) * hsc_onemonth)
## 
## Parameters:
##    Estimate Std. Error t value Pr(>|t|)    
## B0  2.26128    0.31493   7.180 3.78e-10 ***
## B3  0.03229    0.01509   2.139   0.0356 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.791 on 77 degrees of freedom
## 
## Number of iterations to convergence: 1 
## Achieved convergence tolerance: 1.294e-07
##   (35 observations deleted due to missingness)
AIC(strong_diathesis_om)
## [1] 191.121
BIC(strong_diathesis_om)
## [1] 198.2293
pred <- predict(strong_diathesis_om) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(strong_diathesis_om)
w <- weights(strong_diathesis_om)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(strong_diathesis_om)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.05610817
## 
## $adj.R.squared
## [1] 0.04384983

5-5. 弱いヴァンテージ感受性

weak_vs_om <- nls(wb_onemonth ~ B0 + B1*(ev_onemonth - 3) + B3*((ev_onemonth - 3)*hsc_onemonth), #-3は環境変数の最小値（C on X）
                  data = data,
                  start = list(B0 = 90, B1 = 0, B3 = -1))
summary(weak_vs_om)
## 
## Formula: wb_onemonth ~ B0 + B1 * (ev_onemonth - 3) + B3 * ((ev_onemonth - 
##     3) * hsc_onemonth)
## 
## Parameters:
##    Estimate Std. Error t value Pr(>|t|)    
## B0  3.45073    0.20854  16.547   <2e-16 ***
## B1 -0.21576    0.31261  -0.690    0.492    
## B3  0.09069    0.05747   1.578    0.119    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.7663 on 76 degrees of freedom
## 
## Number of iterations to convergence: 1 
## Achieved convergence tolerance: 9.08e-08
##   (35 observations deleted due to missingness)
AIC(weak_vs_om)
## [1] 187.0722
BIC(weak_vs_om)
## [1] 196.5499
pred <- predict(weak_vs_om) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(weak_vs_om)
w <- weights(weak_vs_om)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(weak_vs_om)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.1256822
## 
## $adj.R.squared
## [1] 0.1026738

5-6. 強いヴァンテージ感受性

strong_vs_om <- nls(wb_onemonth ~ B0 + 0*(ev_onemonth - 3) + B3*((ev_onemonth - 3)*hsc_onemonth),
                    data = data,
                    start = list(B0 = 90, B3 = -1))
summary(strong_vs_om)
## 
## Formula: wb_onemonth ~ B0 + 0 * (ev_onemonth - 3) + B3 * ((ev_onemonth - 
##     3) * hsc_onemonth)
## 
## Parameters:
##    Estimate Std. Error t value Pr(>|t|)    
## B0  3.49127    0.19941  17.508  < 2e-16 ***
## B3  0.05265    0.01623   3.243  0.00175 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.7637 on 77 degrees of freedom
## 
## Number of iterations to convergence: 1 
## Achieved convergence tolerance: 9.248e-08
##   (35 observations deleted due to missingness)
AIC(strong_vs_om)
## [1] 185.5658
BIC(strong_vs_om)
## [1] 192.6741
pred <- predict(strong_vs_om) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(strong_vs_om)
w <- weights(strong_vs_om)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(strong_vs_om)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.1202019
## 
## $adj.R.squared
## [1] 0.1087759

（6）Widaman’s Approachのグラフ

  • 以下のように作図します。
HowToCreateWidamanFigure

HowToCreateWidamanFigure

1時点目の作図

# 1時点目は強い素因ストレスモデルが支持された

# B0（切片）=2.12
# B1（傾き：低感受性群）= 0.00
# C（交差点）=3.00
# B3（傾き：高感受性群）= 0.03

#png("figure/week1.png", width = 1200, height = 1200)
p <- ggplot(data, aes(ev_T1, wb_T1)) + 
  geom_abline(intercept = 2.03, slope = 0.03, size = 1) +  
  geom_abline(intercept = 2.12, slope = 0.00, size = 1, linetype = 2) + 
  ylim(1.5, 2.5) + xlim(-3, 3)
p + theme(plot.subtitle = element_text(vjust = 1), 
          plot.caption = element_text(vjust = 1), 
          axis.line = element_line(colour = "azure4", 
                                   linetype = "solid"), axis.ticks = element_line(size = 1,linetype = "blank")) 

#dev.off()

2時点目の作図

# 2時点目は強いヴァンテージ感受性モデルが支持された

# B0（切片）= 3.36
# B1（傾き：低感受性群）= 0.00
# C（交差点）= -3.00
# B3（傾き：高感受性群）= 0.04

#png("figure/week2.png", width = 1200, height = 1200)
p <- ggplot(data, aes(ev_T2, wb_T2)) + 
  geom_abline(intercept = 3.48, slope = 0.04, size = 1) +  
  geom_abline(intercept = 3.36, slope = 0.00, size = 1, linetype = 2) + 
  ylim(3.0, 4.0) + xlim(-3, 3)
p + theme(plot.subtitle = element_text(vjust = 1), 
          plot.caption = element_text(vjust = 1), 
          axis.line = element_line(colour = "azure4", 
                                   linetype = "solid"), axis.ticks = element_line(size = 1,linetype = "blank")) 

#dev.off()

3時点目の作図

# 3時点目は強いヴァンテージ感受性モデルが支持された

# B0（切片）= 3.36
# B1（傾き：低感受性群）= 0.00
# C（交差点）= -3.00
# B3（傾き：高感受性群）= 0.04

#png("figure/week3.png", width = 1200, height = 1200)
p <- ggplot(data, aes(ev_T3, wb_T3)) + 
  geom_abline(intercept = 3.48, slope = 0.04, size = 1) +  
  geom_abline(intercept = 3.36, slope = 0.00, size = 1, linetype = 2) + 
  ylim(3.0, 4.0) + xlim(-3, 3)
p + theme(plot.subtitle = element_text(vjust = 1), 
          plot.caption = element_text(vjust = 1), 
          axis.line = element_line(colour = "azure4", 
                                   linetype = "solid"), axis.ticks = element_line(size = 1,linetype = "blank")) 

#dev.off()

4時点目の作図

# 4時点目は弱い素因ストレスモデルが支持された

# B0（切片）= 2.20
# B1（傾き：低感受性群）= 0.64
# C（交差点）= 3.00
# B3（傾き：高感受性群）= -0.09

#png("figure/week4.png", width = 1200, height = 1200)
p <- ggplot(data, aes(ev_T4, wb_T4)) + 
  geom_abline(intercept = 2.47, slope = -0.09, size = 1) +  
  geom_abline(intercept = 0.28, slope = 0.64, size = 1, linetype = 2) +  
  ylim(0.0, 3.0) + xlim(-3, 3)
p + theme(plot.subtitle = element_text(vjust = 1), 
          plot.caption = element_text(vjust = 1), 
          axis.line = element_line(colour = "azure4", 
                                   linetype = "solid"), axis.ticks = element_line(size = 1,linetype = "blank"))

#dev.off()

1か月全体の作図

# 1か月全体では強いヴァンテージ感受性モデルが支持された

# B0（切片）= 3.49
# B1（傾き：低感受性群）= 0.00
# C（交差点）= 3.00
# B3（傾き：高感受性群）= 0.05

#png("figure/week3.png", width = 1200, height = 1200)
p <- ggplot(data, aes(ev_onemonth, wb_onemonth)) + 
  geom_abline(intercept = 3.64, slope = 0.05, size = 1) +  
  geom_abline(intercept = 3.49, slope = 0.00, size = 1, linetype = 2) +  
  ylim(3.0, 4.0) + xlim(-3, 3)
p + theme(plot.subtitle = element_text(vjust = 1), 
          plot.caption = element_text(vjust = 1), 
          axis.line = element_line(colour = "azure4", 
                                   linetype = "solid"), axis.ticks = element_line(size = 1,linetype = "blank")) 

#dev.off()
WidamanPlot

WidamanPlot

（7）Additional Analysis

  • Journal of Youth and Adolescenceの規定では、メインの分析結果が頑健かどうかを確かめるためにAdditional Analysisのセクションを設けることを推奨している。そのため、この雑誌に投稿するときのことを踏まえて今回の分析でも追加的な分析を行う。
  • 具体的には、 t-1時点のGxEがt時点の従属変数を予測するかどうか検討して、上記のWidamanモデルの頑健性を確認する。

7-1. Roisoman Approach

7-1-1. T1 -> T2

#通常のlmで分析版（ステップ1：主効果モデル）
model_addt2s1 <- lm(data_c$wb_T2 ~ data_c$ev_T1_c + data_c$hsc_T1_c)
summary(model_addt2s1)
## 
## Call:
## lm(formula = data_c$wb_T2 ~ data_c$ev_T1_c + data_c$hsc_T1_c)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -2.18953 -0.61511  0.01373  0.58483  2.09798 
## 
## Coefficients:
##                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)     2.962025   0.103823  28.530   <2e-16 ***
## data_c$ev_T1_c  0.116927   0.065621   1.782   0.0788 .  
## data_c$hsc_T1_c 0.005885   0.144953   0.041   0.9677    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.9228 on 76 degrees of freedom
## Multiple R-squared:  0.04044,    Adjusted R-squared:  0.01519 
## F-statistic: 1.601 on 2 and 76 DF,  p-value: 0.2083
AIC(model_addt2s1)
## [1] 216.4398
BIC(model_addt2s1)
## [1] 225.9176
#通常のlmで分析版（ステップ2：交互作用モデル）
model_addt2s2 <- lm(data_c$wb_T2 ~ data_c$ev_T1_c + data_c$hsc_T1_c + data_c$ev_T1_c:data_c$hsc_T1_c)
summary(model_addt2s2)
## 
## Call:
## lm(formula = data_c$wb_T2 ~ data_c$ev_T1_c + data_c$hsc_T1_c + 
##     data_c$ev_T1_c:data_c$hsc_T1_c)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -2.16674 -0.61954  0.03249  0.57250  2.09993 
## 
## Coefficients:
##                                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                     2.965563   0.105078  28.222   <2e-16 ***
## data_c$ev_T1_c                  0.115262   0.066237   1.740   0.0859 .  
## data_c$hsc_T1_c                -0.006603   0.151369  -0.044   0.9653    
## data_c$ev_T1_c:data_c$hsc_T1_c  0.026571   0.086373   0.308   0.7592    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.9283 on 75 degrees of freedom
## Multiple R-squared:  0.04165,    Adjusted R-squared:  0.003314 
## F-statistic: 1.086 on 3 and 75 DF,  p-value: 0.3601
AIC(model_addt2s2)
## [1] 218.3402
BIC(model_addt2s2)
## [1] 230.1874
anova(model_addt2s1, model_addt2s2) #R^2の増加量の検定

7-1-2. T2 -> T3

#通常のlmで分析版（ステップ1：主効果モデル）
model_addt3s1 <- lm(data_c$wb_T3 ~ data_c$ev_T2_c + data_c$hsc_T2_c)
summary(model_addt3s1)
## 
## Call:
## lm(formula = data_c$wb_T3 ~ data_c$ev_T2_c + data_c$hsc_T2_c)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -2.30406 -0.60488 -0.00416  0.56075  2.21841 
## 
## Coefficients:
##                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)      2.93418    0.10109  29.027   <2e-16 ***
## data_c$ev_T2_c   0.14984    0.06265   2.392   0.0193 *  
## data_c$hsc_T2_c -0.06217    0.13355  -0.466   0.6429    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8985 on 76 degrees of freedom
## Multiple R-squared:  0.07349,    Adjusted R-squared:  0.04911 
## F-statistic: 3.014 on 2 and 76 DF,  p-value: 0.05498
AIC(model_addt3s1)
## [1] 212.2184
BIC(model_addt3s1)
## [1] 221.6962
#通常のlmで分析版（ステップ2：交互作用モデル）
model_addt3s2 <- lm(data_c$wb_T3 ~ data_c$ev_T2_c + data_c$hsc_T2_c + data_c$ev_T2_c:data_c$hsc_T2_c)
summary(model_addt3s2)
## 
## Call:
## lm(formula = data_c$wb_T3 ~ data_c$ev_T2_c + data_c$hsc_T2_c + 
##     data_c$ev_T2_c:data_c$hsc_T2_c)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -2.32889 -0.56732 -0.02328  0.57998  2.24230 
## 
## Coefficients:
##                                Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                     2.93970    0.10062  29.216   <2e-16 ***
## data_c$ev_T2_c                  0.12658    0.06464   1.958   0.0539 .  
## data_c$hsc_T2_c                -0.04409    0.13349  -0.330   0.7421    
## data_c$ev_T2_c:data_c$hsc_T2_c  0.11992    0.08855   1.354   0.1797    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8936 on 75 degrees of freedom
## Multiple R-squared:  0.09561,    Adjusted R-squared:  0.05943 
## F-statistic: 2.643 on 3 and 75 DF,  p-value: 0.05538
AIC(model_addt3s2)
## [1] 212.3099
BIC(model_addt3s2)
## [1] 224.1572
anova(model_addt3s1, model_addt3s2) #R^2の増加量の検定

7-1-3. T3 -> T4

#通常のlmで分析版（ステップ1：主効果モデル）
model_addt4s1 <- lm(data_c$wb_T4 ~ data_c$ev_T3_c + data_c$hsc_T3_c)
summary(model_addt4s1)
## 
## Call:
## lm(formula = data_c$wb_T4 ~ data_c$ev_T3_c + data_c$hsc_T3_c)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -2.3248 -0.6979 -0.1591  0.6893  2.1530 
## 
## Coefficients:
##                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)      2.89114    0.11578  24.971   <2e-16 ***
## data_c$ev_T3_c   0.11250    0.07469   1.506    0.136    
## data_c$hsc_T3_c -0.05158    0.15366  -0.336    0.738    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.029 on 76 degrees of freedom
## Multiple R-squared:  0.03342,    Adjusted R-squared:  0.007984 
## F-statistic: 1.314 on 2 and 76 DF,  p-value: 0.2748
AIC(model_addt4s1)
## [1] 233.6596
BIC(model_addt4s1)
## [1] 243.1374
#通常のlmで分析版（ステップ2：交互作用モデル）
model_addt4s2 <- lm(data_c$wb_T4 ~ data_c$ev_T3_c + data_c$hsc_T3_c + data_c$ev_T3_c:data_c$hsc_T3_c)
summary(model_addt4s2)
## 
## Call:
## lm(formula = data_c$wb_T4 ~ data_c$ev_T3_c + data_c$hsc_T3_c + 
##     data_c$ev_T3_c:data_c$hsc_T3_c)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -2.3585 -0.7028 -0.1558  0.6931  2.1448 
## 
## Coefficients:
##                                Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                     2.90046    0.11756  24.673   <2e-16 ***
## data_c$ev_T3_c                  0.10405    0.07661   1.358    0.179    
## data_c$hsc_T3_c                -0.04964    0.15442  -0.321    0.749    
## data_c$ev_T3_c:data_c$hsc_T3_c  0.04576    0.08368   0.547    0.586    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.034 on 75 degrees of freedom
## Multiple R-squared:  0.03726,    Adjusted R-squared:  -0.00125 
## F-statistic: 0.9675 on 3 and 75 DF,  p-value: 0.4126
AIC(model_addt4s2)
## [1] 235.3453
BIC(model_addt4s2)
## [1] 247.1925
anova(model_addt4s1, model_addt4s2) #R^2の増加量の検定

7-2. Widaman Approach

T1->T2：弱い差次感受性

weak_diff_T1T2 <- nls(wb_T2 ~ B0 + B1*(ev_T1 - C) + B3*((ev_T1 - C)*hsc_T1), 
                    data = data,
                    start = list(B0 = 90, B1 = 0, C = 20, B3 = -1))
summary(weak_diff_T1T2) 
## 
## Formula: wb_T2 ~ B0 + B1 * (ev_T1 - C) + B3 * ((ev_T1 - C) * hsc_T1)
## 
## Parameters:
##      Estimate Std. Error t value Pr(>|t|)
## B0 -9.245e+00  1.611e+03  -0.006    0.995
## B1  1.361e-01  4.012e-01   0.339    0.735
## C  -9.076e+01  1.211e+04  -0.007    0.994
## B3 -5.940e-04  7.810e-02  -0.008    0.994
## 
## Residual standard error: 0.9085 on 93 degrees of freedom
## 
## Number of iterations to convergence: 3 
## Achieved convergence tolerance: 2.258e-06
##   (17 observations deleted due to missingness)
AIC(weak_diff_T1T2)
## [1] 262.5684
BIC(weak_diff_T1T2)
## [1] 275.4419
pred <- predict(weak_diff_T1T2) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(weak_diff_T1T2)
w <- weights(weak_diff_T1T2)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(weak_diff_T1T2)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.05224564
## 
## $adj.R.squared
## [1] 0.02167292

T1->T2：強い差次感受性

strong_diff_T1T2 <- nls(wb_T2 ~ B0 + 0*(ev_T1 - C) + B3*((ev_T1 - C)*hsc_T1),
                      data = data,
                      start = list(B0 = 90, C = 20, B3 = -1))
summary(strong_diff_T1T2)
## 
## Formula: wb_T2 ~ B0 + 0 * (ev_T1 - C) + B3 * ((ev_T1 - C) * hsc_T1)
## 
## Parameters:
##    Estimate Std. Error t value Pr(>|t|)    
## B0  3.28927    0.63085   5.214 1.09e-06 ***
## C   3.45608    5.04675   0.685    0.495    
## B3  0.02559    0.01182   2.165    0.033 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.9042 on 94 degrees of freedom
## 
## Number of iterations to convergence: 2 
## Achieved convergence tolerance: 1.772e-06
##   (17 observations deleted due to missingness)
AIC(strong_diff_T1T2)
## [1] 260.6883
BIC(strong_diff_T1T2)
## [1] 270.9872
pred <- predict(strong_diff_T1T2) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(strong_diff_T1T2)
w <- weights(strong_diff_T1T2)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(strong_diff_T1T2)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.05107284
## 
## $adj.R.squared
## [1] 0.0308829

T1->T2：弱い素因ストレス

weak_diathesis_T1T2 <- nls(wb_T2 ~ B0 + B1*(ev_T1 - 3) + B3*((ev_T1 - 3)*hsc_T1),
                           data = data,
                           start = list(B0 = 90, B1 = 0, B3 = -1)) #Cの初期値は設定不要
summary(weak_diathesis_T1T2)
## 
## Formula: wb_T2 ~ B0 + B1 * (ev_T1 - 3) + B3 * ((ev_T1 - 3) * hsc_T1)
## 
## Parameters:
##    Estimate Std. Error t value Pr(>|t|)    
## B0  3.23942    0.15321  21.144   <2e-16 ***
## B1  0.04910    0.28084   0.175    0.862    
## B3  0.01674    0.05333   0.314    0.754    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.9041 on 94 degrees of freedom
## 
## Number of iterations to convergence: 1 
## Achieved convergence tolerance: 6.146e-08
##   (17 observations deleted due to missingness)
AIC(weak_diathesis_T1T2)
## [1] 260.6654
BIC(weak_diathesis_T1T2)
## [1] 270.9642
pred <- predict(weak_diathesis_T1T2) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(weak_diathesis_T1T2)
w <- weights(weak_diathesis_T1T2)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(weak_diathesis_T1T2)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.0512971
## 
## $adj.R.squared
## [1] 0.03111194

T1->T2：強い素因ストレス

strong_diathesis_T1T2 <- nls(wb_T2 ~ B0 + 0*(ev_T1 - 3) + B3*((ev_T1 - 3)*hsc_T1),
                           data = data,
                           start = list(B0 = 90, B3 = -1))
summary(strong_diathesis_T1T2)
## 
## Formula: wb_T2 ~ B0 + 0 * (ev_T1 - 3) + B3 * ((ev_T1 - 3) * hsc_T1)
## 
## Parameters:
##    Estimate Std. Error t value Pr(>|t|)    
## B0  3.23329    0.14838  21.790   <2e-16 ***
## B3  0.02584    0.01144   2.259   0.0262 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8995 on 95 degrees of freedom
## 
## Number of iterations to convergence: 1 
## Achieved convergence tolerance: 5.69e-08
##   (17 observations deleted due to missingness)
AIC(strong_diathesis_T1T2)
## [1] 258.6969
BIC(strong_diathesis_T1T2)
## [1] 266.4211
pred <- predict(strong_diathesis_T1T2) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(strong_diathesis_T1T2)
w <- weights(strong_diathesis_T1T2)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(strong_diathesis_T1T2)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.05098863
## 
## $adj.R.squared
## [1] 0.04099904

T1->T2：弱いヴァンテージ感受性

weak_vs_T1T2 <- nls(wb_T2 ~ B0 + B1*(ev_T1 + 3) + B3*((ev_T1 + 3)*hsc_T1), #+3は環境変数の最小値（C on X）→ -(c)なので+3となる
                  data = data,
                  start = list(B0 = 90, B1 = 0, B3 = -1))
summary(weak_vs_T1T2)
## 
## Formula: wb_T2 ~ B0 + B1 * (ev_T1 + 3) + B3 * ((ev_T1 + 3) * hsc_T1)
## 
## Parameters:
##    Estimate Std. Error t value Pr(>|t|)    
## B0  2.43476    0.25788   9.441 2.83e-15 ***
## B1  0.19040    0.14652   1.299    0.197    
## B3 -0.01124    0.02715  -0.414    0.680    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.9037 on 94 degrees of freedom
## 
## Number of iterations to convergence: 1 
## Achieved convergence tolerance: 6.7e-08
##   (17 observations deleted due to missingness)
AIC(weak_vs_T1T2)
## [1] 260.5904
BIC(weak_vs_T1T2)
## [1] 270.8893
pred <- predict(weak_vs_T1T2) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(weak_vs_T1T2)
w <- weights(weak_vs_T1T2)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(weak_vs_T1T2)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.05203008
## 
## $adj.R.squared
## [1] 0.0318605

T1->T2：強いヴァンテージ感受性

strong_vs_T1T2 <- nls(wb_T2 ~ B0 + 0*(ev_T1 + 3) + B3*((ev_T1 + 3)*hsc_T1),
                    data = data,
                    start = list(B0 = 90, B3 = -1))
summary(strong_vs_T1T2)
## 
## Formula: wb_T2 ~ B0 + 0 * (ev_T1 + 3) + B3 * ((ev_T1 + 3) * hsc_T1)
## 
## Parameters:
##    Estimate Std. Error t value Pr(>|t|)    
## B0  2.55376    0.24195  10.555   <2e-16 ***
## B3  0.02090    0.01126   1.856   0.0665 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.907 on 95 degrees of freedom
## 
## Number of iterations to convergence: 1 
## Achieved convergence tolerance: 1.977e-08
##   (17 observations deleted due to missingness)
AIC(strong_vs_T1T2)
## [1] 260.3175
BIC(strong_vs_T1T2)
## [1] 268.0416
pred <- predict(strong_vs_T1T2) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(strong_vs_T1T2)
w <- weights(strong_vs_T1T2)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(strong_vs_T1T2)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.03500062
## 
## $adj.R.squared
## [1] 0.02484274

T2->T3：弱い差次感受性

weak_diff_T2T3 <- nls(wb_T3 ~ B0 + B1*(ev_T2 - C) + B3*((ev_T2 - C)*hsc_T2), 
                      data = data,
                      start = list(B0 = 90, B1 = 0, C = 20, B3 = -1))
summary(weak_diff_T2T3) 
## 
## Formula: wb_T3 ~ B0 + B1 * (ev_T2 - C) + B3 * ((ev_T2 - C) * hsc_T2)
## 
## Parameters:
##    Estimate Std. Error t value Pr(>|t|)    
## B0  2.97074    0.17526  16.950   <2e-16 ***
## B1 -0.45735    0.44327  -1.032    0.305    
## C   1.18350    1.18338   1.000    0.320    
## B3  0.11343    0.08266   1.372    0.174    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8706 on 83 degrees of freedom
## 
## Number of iterations to convergence: 2 
## Achieved convergence tolerance: 4.556e-06
##   (27 observations deleted due to missingness)
AIC(weak_diff_T2T3)
## [1] 228.6799
BIC(weak_diff_T2T3)
## [1] 241.0094
pred <- predict(weak_diff_T2T3) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(weak_diff_T2T3)
w <- weights(weak_diff_T2T3)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(weak_diff_T2T3)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.09919759
## 
## $adj.R.squared
## [1] 0.06663847

T2->T3：強い差次感受性

strong_diff_T2T3 <- nls(wb_T3 ~ B0 + 0*(ev_T2 - C) + B3*((ev_T2 - C)*hsc_T2),
                        data = data,
                        start = list(B0 = 90, C = 20, B3 = -1))
summary(strong_diff_T2T3)
## 
## Formula: wb_T3 ~ B0 + 0 * (ev_T2 - C) + B3 * ((ev_T2 - C) * hsc_T2)
## 
## Parameters:
##    Estimate Std. Error t value Pr(>|t|)    
## B0  3.19621    0.65888   4.851 5.59e-06 ***
## C   2.68963    4.52401   0.595  0.55376    
## B3  0.02883    0.01046   2.756  0.00717 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8709 on 84 degrees of freedom
## 
## Number of iterations to convergence: 2 
## Achieved convergence tolerance: 6.624e-07
##   (27 observations deleted due to missingness)
AIC(strong_diff_T2T3)
## [1] 227.7886
BIC(strong_diff_T2T3)
## [1] 237.6522
pred <- predict(strong_diff_T2T3) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(strong_diff_T2T3)
w <- weights(strong_diff_T2T3)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(strong_diff_T2T3)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.08764425
## 
## $adj.R.squared
## [1] 0.0659215

T2->T3：弱い素因ストレス

weak_diathesis_T2T3 <- nls(wb_T3 ~ B0 + B1*(ev_T2 - 3) + B3*((ev_T2 - 3)*hsc_T2), #+3は環境変数の最大値(C on X)
                           data = data,
                           start = list(B0 = 90, B1 = 0, B3 = -1)) #Cの初期値は設定不要
summary(weak_diathesis_T2T3)
## 
## Formula: wb_T3 ~ B0 + B1 * (ev_T2 - 3) + B3 * ((ev_T2 - 3) * hsc_T2)
## 
## Parameters:
##    Estimate Std. Error t value Pr(>|t|)    
## B0  3.21285    0.16027  20.046   <2e-16 ***
## B1 -0.13246    0.25062  -0.529    0.599    
## B3  0.05193    0.04521   1.149    0.254    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8695 on 84 degrees of freedom
## 
## Number of iterations to convergence: 1 
## Achieved convergence tolerance: 1.081e-07
##   (27 observations deleted due to missingness)
AIC(weak_diathesis_T2T3)
## [1] 227.5046
BIC(weak_diathesis_T2T3)
## [1] 237.3682
pred <- predict(weak_diathesis_T2T3) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(weak_diathesis_T2T3)
w <- weights(weak_diathesis_T2T3)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(weak_diathesis_T2T3)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.09061783
## 
## $adj.R.squared
## [1] 0.06896587

T2->T3：強い素因ストレス

strong_diathesis_T2T3 <- nls(wb_T3 ~ B0 + 0*(ev_T2 - 3) + B3*((ev_T2 - 3)*hsc_T2),
                             data = data,
                             start = list(B0 = 90, B3 = -1))
summary(strong_diathesis_T2T3)
## 
## Formula: wb_T3 ~ B0 + 0 * (ev_T2 - 3) + B3 * ((ev_T2 - 3) * hsc_T2)
## 
## Parameters:
##    Estimate Std. Error t value Pr(>|t|)    
## B0  3.23991    0.15123  21.424  < 2e-16 ***
## B3  0.02864    0.01002   2.857  0.00538 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8658 on 85 degrees of freedom
## 
## Number of iterations to convergence: 1 
## Achieved convergence tolerance: 8.105e-08
##   (27 observations deleted due to missingness)
AIC(strong_diathesis_T2T3)
## [1] 225.7934
BIC(strong_diathesis_T2T3)
## [1] 233.1911
pred <- predict(strong_diathesis_T2T3) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(strong_diathesis_T2T3)
w <- weights(strong_diathesis_T2T3)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(strong_diathesis_T2T3)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.08759377
## 
## $adj.R.squared
## [1] 0.07685958

T2->T3：弱いヴァンテージ感受性

weak_vs_T2T3 <- nls(wb_T3 ~ B0 + B1*(ev_T2 + 3) + B3*((ev_T2 + 3)*hsc_T2), #-3は環境変数の最小値（C on X）
                    data = data,
                    start = list(B0 = 90, B1 = 0, B3 = -1))
summary(weak_vs_T2T3)
## 
## Formula: wb_T3 ~ B0 + B1 * (ev_T2 + 3) + B3 * ((ev_T2 + 3) * hsc_T2)
## 
## Parameters:
##    Estimate Std. Error t value Pr(>|t|)    
## B0 2.351255   0.228560  10.287   <2e-16 ***
## B1 0.132347   0.176366   0.750    0.455    
## B3 0.003054   0.032224   0.095    0.925    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.8762 on 84 degrees of freedom
## 
## Number of iterations to convergence: 1 
## Achieved convergence tolerance: 1.505e-07
##   (27 observations deleted due to missingness)
AIC(weak_vs_T2T3)
## [1] 228.8512
BIC(weak_vs_T2T3)
## [1] 238.7148
pred <- predict(weak_vs_T2T3) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(weak_vs_T2T3)
w <- weights(weak_vs_T2T3)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(weak_vs_T2T3)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.07643295
## 
## $adj.R.squared
## [1] 0.05444326

T2->T3：強いヴァンテージ感受性

strong_vs_T2T3 <- nls(wb_T3 ~ B0 + 0*(ev_T2 + 3) + B3*((ev_T2 + 3)*hsc_T2),
                      data = data,
                      start = list(B0 = 90, B3 = -1))
summary(strong_vs_T2T3)
## 
## Formula: wb_T3 ~ B0 + 0 * (ev_T2 + 3) + B3 * ((ev_T2 + 3) * hsc_T2)
## 
## Parameters:
##    Estimate Std. Error t value Pr(>|t|)    
## B0  2.40765    0.21530  11.183   <2e-16 ***
## B3  0.02597    0.01025   2.534   0.0131 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.874 on 85 degrees of freedom
## 
## Number of iterations to convergence: 1 
## Achieved convergence tolerance: 1.361e-07
##   (27 observations deleted due to missingness)
AIC(strong_vs_T2T3)
## [1] 227.4324
BIC(strong_vs_T2T3)
## [1] 234.8302
pred <- predict(strong_vs_T2T3) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(strong_vs_T2T3)
w <- weights(strong_vs_T2T3)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(strong_vs_T2T3)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.07024157
## 
## $adj.R.squared
## [1] 0.05930324

T3->T4：弱い差次感受性

weak_diff_T3T4 <- nls(wb_T4 ~ B0 + B1*(ev_T3 - C) + B3*((ev_T3 - C)*hsc_T3), 
                      data = data,
                      start = list(B0 = 90, B1 = 0, C = 20, B3 = -1))
summary(weak_diff_T3T4) 
## 
## Formula: wb_T4 ~ B0 + B1 * (ev_T3 - C) + B3 * ((ev_T3 - C) * hsc_T3)
## 
## Parameters:
##    Estimate Std. Error t value Pr(>|t|)    
## B0  3.19170    0.81504   3.916 0.000172 ***
## B1 -0.04837    0.43683  -0.111 0.912067    
## C   2.36499    4.38604   0.539 0.591032    
## B3  0.04440    0.07909   0.561 0.575888    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.048 on 93 degrees of freedom
## 
## Number of iterations to convergence: 2 
## Achieved convergence tolerance: 2.084e-06
##   (17 observations deleted due to missingness)
AIC(weak_diff_T3T4)
## [1] 290.2987
BIC(weak_diff_T3T4)
## [1] 303.1722
pred <- predict(weak_diff_T3T4) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(weak_diff_T3T4)
w <- weights(weak_diff_T3T4)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(weak_diff_T3T4)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.09417401
## 
## $adj.R.squared
## [1] 0.06495382

T3->T4：強い差次感受性

strong_diff_T3T4 <- nls(wb_T4 ~ B0 + 0*(ev_T3 - C) + B3*((ev_T3 - C)*hsc_T3),
                        data = data,
                        start = list(B0 = 90, C = 20, B3 = -1))
summary(strong_diff_T3T4)
## 
## Formula: wb_T4 ~ B0 + 0 * (ev_T3 - C) + B3 * ((ev_T3 - C) * hsc_T3)
## 
## Parameters:
##    Estimate Std. Error t value Pr(>|t|)    
## B0  3.26609    0.76899   4.247 5.09e-05 ***
## C   2.74578    4.24744   0.646  0.51956    
## B3  0.03575    0.01223   2.923  0.00434 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.043 on 94 degrees of freedom
## 
## Number of iterations to convergence: 2 
## Achieved convergence tolerance: 4.965e-07
##   (17 observations deleted due to missingness)
AIC(strong_diff_T3T4)
## [1] 288.3115
BIC(strong_diff_T3T4)
## [1] 298.6103
pred <- predict(strong_diff_T3T4) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(strong_diff_T3T4)
w <- weights(strong_diff_T3T4)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(strong_diff_T3T4)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.09405458
## 
## $adj.R.squared
## [1] 0.07477915

T3->T4：弱い素因ストレス

weak_diathesis_T3T4 <- nls(wb_T4 ~ B0 + B1*(ev_T3 - 3) + B3*((ev_T3 - 3)*hsc_T3), #+3は環境変数の最大値(C on X)
                           data = data,
                           start = list(B0 = 90, B1 = 0, B3 = -1)) #Cの初期値は設定不要
summary(weak_diathesis_T3T4)
## 
## Formula: wb_T4 ~ B0 + B1 * (ev_T3 - 3) + B3 * ((ev_T3 - 3) * hsc_T3)
## 
## Parameters:
##     Estimate Std. Error t value Pr(>|t|)    
## B0  3.308476   0.190535  17.364   <2e-16 ***
## B1 -0.008593   0.289132  -0.030    0.976    
## B3  0.036915   0.049646   0.744    0.459    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.043 on 94 degrees of freedom
## 
## Number of iterations to convergence: 1 
## Achieved convergence tolerance: 8.2e-08
##   (17 observations deleted due to missingness)
AIC(weak_diathesis_T3T4)
## [1] 288.3142
BIC(weak_diathesis_T3T4)
## [1] 298.613
pred <- predict(weak_diathesis_T3T4) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(weak_diathesis_T3T4)
w <- weights(weak_diathesis_T3T4)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(weak_diathesis_T3T4)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.09402908
## 
## $adj.R.squared
## [1] 0.0747531

T3->T4：強い素因ストレス

strong_diathesis_T3T4 <- nls(wb_T4 ~ B0 + 0*(ev_T3 - 3) + B3*((ev_T3 - 3)*hsc_T3),
                             data = data,
                             start = list(B0 = 90, B3 = -1))
summary(strong_diathesis_T3T4)
## 
## Formula: wb_T4 ~ B0 + 0 * (ev_T3 - 3) + B3 * ((ev_T3 - 3) * hsc_T3)
## 
## Parameters:
##    Estimate Std. Error t value Pr(>|t|)    
## B0  3.31054    0.17645   18.76  < 2e-16 ***
## B3  0.03548    0.01130    3.14  0.00225 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.037 on 95 degrees of freedom
## 
## Number of iterations to convergence: 1 
## Achieved convergence tolerance: 5.754e-08
##   (17 observations deleted due to missingness)
AIC(strong_diathesis_T3T4)
## [1] 286.3151
BIC(strong_diathesis_T3T4)
## [1] 294.0392
pred <- predict(strong_diathesis_T3T4) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(strong_diathesis_T3T4)
w <- weights(strong_diathesis_T3T4)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(strong_diathesis_T3T4)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.09402056
## 
## $adj.R.squared
## [1] 0.08448394

T3->T4：弱いヴァンテージ感受性

weak_vs_T3T4 <- nls(wb_T4 ~ B0 + B1*(ev_T3 + 3) + B3*((ev_T3 + 3)*hsc_T3), #-3は環境変数の最小値（C on X）
                    data = data,
                    start = list(B0 = 90, B1 = 0, B3 = -1))
summary(weak_vs_T3T4)
## 
## Formula: wb_T4 ~ B0 + B1 * (ev_T3 + 3) + B3 * ((ev_T3 + 3) * hsc_T3)
## 
## Parameters:
##     Estimate Std. Error t value Pr(>|t|)    
## B0  2.132789   0.265543   8.032 2.74e-12 ***
## B1  0.235887   0.190272   1.240    0.218    
## B3 -0.006894   0.034935  -0.197    0.844    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.045 on 94 degrees of freedom
## 
## Number of iterations to convergence: 1 
## Achieved convergence tolerance: 6.827e-08
##   (17 observations deleted due to missingness)
AIC(weak_vs_T3T4)
## [1] 288.8429
BIC(weak_vs_T3T4)
## [1] 299.1417
pred <- predict(weak_vs_T3T4) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(weak_vs_T3T4)
w <- weights(weak_vs_T3T4)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(weak_vs_T3T4)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.0890777
## 
## $adj.R.squared
## [1] 0.06969638

T3->T4：強いヴァンテージ感受性

strong_vs_T3T4 <- nls(wb_T4 ~ B0 + 0*(ev_T3 + 3) + B3*((ev_T3 + 3)*hsc_T3),
                      data = data,
                      start = list(B0 = 90, B3 = -1))
summary(strong_vs_T3T4)
## 
## Formula: wb_T4 ~ B0 + 0 * (ev_T3 + 3) + B3 * ((ev_T3 + 3) * hsc_T3)
## 
## Parameters:
##    Estimate Std. Error t value Pr(>|t|)    
## B0  2.22409    0.25585   8.693 1.02e-13 ***
## B3  0.03370    0.01221   2.759  0.00696 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.048 on 95 degrees of freedom
## 
## Number of iterations to convergence: 1 
## Achieved convergence tolerance: 6.119e-08
##   (17 observations deleted due to missingness)
AIC(strong_vs_T3T4)
## [1] 288.416
BIC(strong_vs_T3T4)
## [1] 296.1402
pred <- predict(strong_vs_T3T4) #非線形モデルで準R2を算出する
n <- length(pred)
res <- resid(strong_vs_T3T4)
w <- weights(strong_vs_T3T4)
if (is.null(w)) w <- rep(1, n)
rss <- sum(w * res ^ 2)
resp <- pred + res
center <- weighted.mean(resp, w)
r.df <- summary(strong_vs_T3T4)$df[2]
int.df <- 1
tss <- sum(w * (resp - center)^2)
r.sq <- 1 - rss/tss
adj.r.sq <- 1 - (1 - r.sq) * (n - int.df) / r.df
out <- list(pseudo.R.squared = r.sq,
            adj.R.squared = adj.r.sq)
out
## $pseudo.R.squared
## [1] 0.07418374
## 
## $adj.R.squared
## [1] 0.06443831

Additional Analysisの作図

# T1->T2は強いヴァンテージ感受性モデルが支持された

# B0（切片）=3.23
# B1（傾き：低感受性群）= 0.00
# C（交差点）=3.00
# B3（傾き：高感受性群）= 0.03

#png("figure/ad1.png", width = 1200, height = 1200)
p <- ggplot(data, aes(ev_T1, wb_T2)) + 
  geom_abline(intercept = 3.32, slope = 0.03, size = 1) +  
  geom_abline(intercept = 3.23, slope = 0.00, size = 1, linetype = 2) + 
  ylim(3.00, 4.00) + xlim(-3, 3)
p + theme(plot.subtitle = element_text(vjust = 1), 
          plot.caption = element_text(vjust = 1), 
          axis.line = element_line(colour = "azure4", 
                                   linetype = "solid"), axis.ticks = element_line(size = 1,linetype = "blank")) 

#dev.off()

T2->T3は強いヴァンテージ感受性モデルが支持された

# B0（切片）=3.24
# B1（傾き：低感受性群）= 0.00
# C（交差点）=3.00
# B3（傾き：高感受性群）= 0.03

#png("figure/ad2.png", width = 1200, height = 1200)
p <- ggplot(data, aes(ev_T2, wb_T3)) + 
  geom_abline(intercept = 3.33, slope = 0.03, size = 1) +  
  geom_abline(intercept = 3.24, slope = 0.00, size = 1, linetype = 2) + 
  ylim(3.00, 4.00) + xlim(-3, 3)
p + theme(plot.subtitle = element_text(vjust = 1), 
          plot.caption = element_text(vjust = 1), 
          axis.line = element_line(colour = "azure4", 
                                   linetype = "solid"), axis.ticks = element_line(size = 1,linetype = "blank")) 

#dev.off()

T3->T4は強いヴァンテージ感受性モデルが支持された

# B0（切片）=3.31
# B1（傾き：低感受性群）= 0.00
# C（交差点）=3.00
# B3（傾き：高感受性群）= 0.03

#png("figure/ad3.png", width = 1200, height = 1200)
p <- ggplot(data, aes(ev_T3, wb_T4)) + 
  geom_abline(intercept = 3.43, slope = 0.04, size = 1) +  
  geom_abline(intercept = 3.31, slope = 0.00, size = 1, linetype = 2) + 
  ylim(3.00, 4.00) + xlim(-3, 3)
p + theme(plot.subtitle = element_text(vjust = 1), 
          plot.caption = element_text(vjust = 1), 
          axis.line = element_line(colour = "azure4", 
                                   linetype = "solid"), axis.ticks = element_line(size = 1,linetype = "blank")) 

#dev.off()

（8）LEGITパッケージによる検算

library(LEGIT) 
## Loading required package: formula.tools
# https://cran.r-project.org/web/packages/LEGIT/vignettes/GxE_testing.html
df <- as.data.frame(data) #データフレームとして明示

8-1. 1時点目の強いヴァンテージ感受性モデル

GxE_test_BIC = GxE_interaction_test(data=df, genes=df[,"hsc_T1", drop=FALSE], env=df[,"ev_T1", drop = FALSE], formula_noGxE = wb_T1 ~ 1, crossover = c("min","max"), criterion="BIC")
GxE_test_BIC
## $fits
## $fits$vantage_sensitivity_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##     2.12140      0.03211  
## 
## Degrees of Freedom: 110 Total (i.e. Null);  109 Residual
## Null Deviance:       78.03 
## Residual Deviance: 69.74     AIC: 269.4
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_T1  
##      1  
## 
## Degrees of Freedom: 111 Total (i.e. Null);  110 Residual
## Null Deviance:       119.6 
## Residual Deviance: 69.74     AIC: 267.4
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T1  
##     1  
## 
## Degrees of Freedom: 111 Total (i.e. Null);  110 Residual
## Null Deviance:       80.3 
## Residual Deviance: 69.71     AIC: 267.4
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 269.4123
## 
## $true_model_parameters$AICc
## [1] 269.6366
## 
## $true_model_parameters$BIC
## [1] 277.5409
## 
## $true_model_parameters$rank
## [1] 2
## 
## $true_model_parameters$df.residual
## [1] 109
## 
## $true_model_parameters$null.deviance
## [1] 78.02667
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T1 ~ 1 + G * E - G - E
## <environment: 0x00000000195407f8>
## 
## $crossover
## [1] -3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$diathesis_stress_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##     3.09068      0.03159  
## 
## Degrees of Freedom: 110 Total (i.e. Null);  109 Residual
## Null Deviance:       78.03 
## Residual Deviance: 69.85     AIC: 269.6
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_T1  
##      1  
## 
## Degrees of Freedom: 111 Total (i.e. Null);  110 Residual
## Null Deviance:       92.2 
## Residual Deviance: 69.85     AIC: 267.6
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T1  
##     1  
## 
## Degrees of Freedom: 111 Total (i.e. Null);  110 Residual
## Null Deviance:       80.17 
## Residual Deviance: 69.81     AIC: 267.5
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 269.5838
## 
## $true_model_parameters$AICc
## [1] 269.8081
## 
## $true_model_parameters$BIC
## [1] 277.7124
## 
## $true_model_parameters$rank
## [1] 2
## 
## $true_model_parameters$df.residual
## [1] 109
## 
## $true_model_parameters$null.deviance
## [1] 78.02667
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T1 ~ 1 + G * E - G - E
## <environment: 0x000000001a623758>
## 
## $crossover
## [1] 3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$model_E_only
## 
## Call:  glm(formula = formula_model_E_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
## (Intercept)        ev_T1  
##      2.5927       0.1765  
## 
## Degrees of Freedom: 111 Total (i.e. Null);  110 Residual
##   (2 observations deleted due to missingness)
## Null Deviance:       78.04 
## Residual Deviance: 69.24     AIC: 270
## 
## $fits$vantage_sensitivity_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##     2.06101      0.12509      0.01038  
## 
## Degrees of Freedom: 110 Total (i.e. Null);  108 Residual
## Null Deviance:       78.03 
## Residual Deviance: 69.11     AIC: 270.4
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_T1  
##      1  
## 
## Degrees of Freedom: 111 Total (i.e. Null);  110 Residual
## Null Deviance:       74.32 
## Residual Deviance: 69.11     AIC: 266.4
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T1  
##     1  
## 
## Degrees of Freedom: 111 Total (i.e. Null);  110 Residual
## Null Deviance:       80.25 
## Residual Deviance: 69.11     AIC: 266.4
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 270.4063
## 
## $true_model_parameters$AICc
## [1] 270.7837
## 
## $true_model_parameters$BIC
## [1] 281.2445
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 108
## 
## $true_model_parameters$null.deviance
## [1] 78.02667
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T1 ~ 1 + G * E - G
## <environment: 0x000000001bf2d590>
## 
## $crossover
## [1] -3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$model_GandE_only
## 
## Call:  glm(formula = formula_model_GandE_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
## (Intercept)       hsc_T1        ev_T1  
##     2.35719      0.04629      0.17892  
## 
## Degrees of Freedom: 110 Total (i.e. Null);  108 Residual
##   (3 observations deleted due to missingness)
## Null Deviance:       78.03 
## Residual Deviance: 69.11     AIC: 270.4
## 
## $fits$diathesis_stress_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##     3.12607      0.23339     -0.01082  
## 
## Degrees of Freedom: 110 Total (i.e. Null);  108 Residual
## Null Deviance:       78.03 
## Residual Deviance: 69.19     AIC: 270.5
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_T1  
##      1  
## 
## Degrees of Freedom: 111 Total (i.e. Null);  110 Residual
## Null Deviance:       71.81 
## Residual Deviance: 69.19     AIC: 266.5
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T1  
##     1  
## 
## Degrees of Freedom: 111 Total (i.e. Null);  110 Residual
## Null Deviance:       80.37 
## Residual Deviance: 69.19     AIC: 266.5
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 270.5387
## 
## $true_model_parameters$AICc
## [1] 270.9161
## 
## $true_model_parameters$BIC
## [1] 281.3769
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 108
## 
## $true_model_parameters$null.deviance
## [1] 78.02667
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T1 ~ 1 + G * E - G
## <environment: 0x0000000017f02fa0>
## 
## $crossover
## [1] 3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$diff_suscept_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##     2.57411      0.03401  
## 
## Degrees of Freedom: 110 Total (i.e. Null);  109 Residual
## Null Deviance:       78.03 
## Residual Deviance: 69.23     AIC: 268.6
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_T1  
##      1  
## 
## Degrees of Freedom: 111 Total (i.e. Null);  110 Residual
## Null Deviance:       80.84 
## Residual Deviance: 69.23     AIC: 266.6
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## crossover      ev_T1  
##   -0.1598     1.0000  
## 
## Degrees of Freedom: 111 Total (i.e. Null);  109 Residual
## Null Deviance:       80.84 
## Residual Deviance: 69.23     AIC: 268.6
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 270.6064
## 
## $true_model_parameters$AICc
## [1] 270.9837
## 
## $true_model_parameters$BIC
## [1] 281.4445
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 108
## 
## $true_model_parameters$null.deviance
## [1] 78.02667
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T1 ~ 1 + G * E - G - E
## <environment: 0x000000001ba868b8>
## 
## $crossover
## [1] -0.1597996
## 
## $crossover_fixed
## [1] FALSE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$diff_suscept_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##    1.452928     0.147320     0.006115  
## 
## Degrees of Freedom: 110 Total (i.e. Null);  108 Residual
## Null Deviance:       78.03 
## Residual Deviance: 69.1  AIC: 270.4
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_T1  
##      1  
## 
## Degrees of Freedom: 111 Total (i.e. Null);  110 Residual
## Null Deviance:       74.92 
## Residual Deviance: 69.1  AIC: 266.4
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## crossover      ev_T1  
##    -6.395      1.000  
## 
## Degrees of Freedom: 111 Total (i.e. Null);  109 Residual
## Null Deviance:       260 
## Residual Deviance: 69.1  AIC: 268.4
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 272.4009
## 
## $true_model_parameters$AICc
## [1] 272.9723
## 
## $true_model_parameters$BIC
## [1] 285.9485
## 
## $true_model_parameters$rank
## [1] 4
## 
## $true_model_parameters$df.residual
## [1] 107
## 
## $true_model_parameters$null.deviance
## [1] 78.02667
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T1 ~ 1 + G * E - G
## <environment: 0x000000001ae58590>
## 
## $crossover
## [1] -6.394522
## 
## $crossover_fixed
## [1] FALSE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$model_intercept_only
## 
## Call:  glm(formula = formula_model_intercept_only, family = family, 
##     data = cbind(data, genes, env))
## 
## Coefficients:
## (Intercept)  
##       2.735  
## 
## Degrees of Freedom: 112 Total (i.e. Null);  112 Residual
##   (1 observation deleted due to missingness)
## Null Deviance:       78.12 
## Residual Deviance: 78.12     AIC: 283
## 
## $fits$model_G_only
## 
## Call:  glm(formula = formula_model_G_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
## (Intercept)       hsc_T1  
##    2.772872    -0.007356  
## 
## Degrees of Freedom: 111 Total (i.e. Null);  110 Residual
##   (2 observations deleted due to missingness)
## Null Deviance:       78.1 
## Residual Deviance: 78.09     AIC: 283.5
## 
## 
## $results
##                                    BIC      crossover crossover 95%      
## Vantage sensitivity STRONG         "277.54" "-3"      ""                 
## Diathesis-stress STRONG            "277.71" "3"       ""                 
## E only                             "278.13" NA        ""                 
## Vantage sensitivity WEAK           "281.24" "-3"      ""                 
## G + E only                         "281.25" NA        ""                 
## Diathesis-stress WEAK              "281.38" "3"       ""                 
## Differential susceptibility STRONG "281.44" "-0.16"   "( -1.1 / 0.78 )"  
## Differential susceptibility WEAK   "285.95" "-6.39"   "( -7.32 / -5.47 )"
## Intercept only                     "288.42" NA        ""                 
## G only                             "291.61" NA        ""                 
##                                    Within observable range?
## Vantage sensitivity STRONG         ""                      
## Diathesis-stress STRONG            ""                      
## E only                             ""                      
## Vantage sensitivity WEAK           ""                      
## G + E only                         ""                      
## Diathesis-stress WEAK              ""                      
## Differential susceptibility STRONG "Yes"                   
## Differential susceptibility WEAK   "No"                    
## Intercept only                     ""                      
## G only                             ""                      
##                                    % of observations below crossover
## Vantage sensitivity STRONG         "0.027027027027027"              
## Diathesis-stress STRONG            "1"                              
## E only                             NA                               
## Vantage sensitivity WEAK           "0"                              
## G + E only                         NA                               
## Diathesis-stress WEAK              "1"                              
## Differential susceptibility STRONG "0.225225225225225"              
## Differential susceptibility WEAK   "0"                              
## Intercept only                     NA                               
## G only                             NA                               
## 
## $E_range
## [1] -3  3
# fits[[1]] is the best model (based on BIC)
summary(GxE_test_BIC$fits[[1]]) 
## $fit_main
## 
## Call:
## stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -1.77348  -0.57125  -0.01914   0.58977   1.86525  
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 2.121405   0.186187  11.394  < 2e-16 ***
## G:E         0.032112   0.008921   3.599 0.000481 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.6397929)
## 
##     Null deviance: 78.027  on 110  degrees of freedom
## Residual deviance: 69.737  on 109  degrees of freedom
## AIC: 269.41
## 
## Number of Fisher Scoring iterations: 2
## 
## 
## $fit_genes
## 
## Call:
## stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -1.77348  -0.57125  -0.01914   0.58977   1.86525  
## 
## Coefficients: (-1 not defined because of singularities)
##        Estimate Std. Error t value Pr(>|t|)    
## hsc_T1   1.0000     0.1133   8.827    2e-14 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.6397929)
## 
##     Null deviance: 78.027  on 111  degrees of freedom
## Residual deviance: 69.737  on 109  degrees of freedom
## AIC: 269.41
## 
## Number of Fisher Scoring iterations: 2
## 
## 
## $fit_env
## 
## Call:
## stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -1.77934  -0.59527  -0.01914   0.59115   1.84911  
## 
## Coefficients: (-1 not defined because of singularities)
##       Estimate Std. Error t value Pr(>|t|)    
## ev_T1   1.0000     0.2458   4.069 8.96e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.6395499)
## 
##     Null deviance: 78.027  on 111  degrees of freedom
## Residual deviance: 69.711  on 109  degrees of freedom
## AIC: 269.41
## 
## Number of Fisher Scoring iterations: 2
plot(GxE_test_BIC$fits$vantage_sensitivity_STRONG, xlim=c(-3,3), ylim=c(1,4), legend = "bottomright")

8-2. 2時点目の強い素因ストレスモデル

GxE_test_BIC = GxE_interaction_test(data=df, genes=df[,"hsc_T2", drop=FALSE], env=df[,"ev_T2", drop = FALSE], formula_noGxE = wb_T2 ~ 1, crossover = c("min","max"), criterion="BIC")
GxE_test_BIC
## $fits
## $fits$diathesis_stress_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##     3.35618      0.03618  
## 
## Degrees of Freedom: 92 Total (i.e. Null);  91 Residual
## Null Deviance:       75.29 
## Residual Deviance: 65.59     AIC: 237.4
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_T2  
##      1  
## 
## Degrees of Freedom: 93 Total (i.e. Null);  92 Residual
## Null Deviance:       90.92 
## Residual Deviance: 65.59     AIC: 235.4
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T2  
##     1  
## 
## Degrees of Freedom: 93 Total (i.e. Null);  92 Residual
## Null Deviance:       76.65 
## Residual Deviance: 65.59     AIC: 235.4
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 237.4473
## 
## $true_model_parameters$AICc
## [1] 237.717
## 
## $true_model_parameters$BIC
## [1] 245.0451
## 
## $true_model_parameters$rank
## [1] 2
## 
## $true_model_parameters$df.residual
## [1] 91
## 
## $true_model_parameters$null.deviance
## [1] 75.29118
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T2 ~ 1 + G * E - G - E
## <environment: 0x000000001a9fb080>
## 
## $crossover
## [1] 3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$vantage_sensitivity_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##     2.33356      0.03224  
## 
## Degrees of Freedom: 92 Total (i.e. Null);  91 Residual
## Null Deviance:       75.29 
## Residual Deviance: 67.65     AIC: 240.3
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_T2  
##      1  
## 
## Degrees of Freedom: 93 Total (i.e. Null);  92 Residual
## Null Deviance:       110.2 
## Residual Deviance: 67.65     AIC: 238.3
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T2  
##     1  
## 
## Degrees of Freedom: 93 Total (i.e. Null);  92 Residual
## Null Deviance:       78.26 
## Residual Deviance: 67.52     AIC: 238.1
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 240.3212
## 
## $true_model_parameters$AICc
## [1] 240.5908
## 
## $true_model_parameters$BIC
## [1] 247.919
## 
## $true_model_parameters$rank
## [1] 2
## 
## $true_model_parameters$df.residual
## [1] 91
## 
## $true_model_parameters$null.deviance
## [1] 75.29118
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T2 ~ 1 + G * E - G - E
## <environment: 0x0000000018d0df68>
## 
## $crossover
## [1] -3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$diathesis_stress_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##     3.33441     -0.10358      0.05461  
## 
## Degrees of Freedom: 92 Total (i.e. Null);  90 Residual
## Null Deviance:       75.29 
## Residual Deviance: 65.4  AIC: 239.2
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_T2  
##      1  
## 
## Degrees of Freedom: 93 Total (i.e. Null);  92 Residual
## Null Deviance:       123.1 
## Residual Deviance: 65.4  AIC: 235.2
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T2  
##     1  
## 
## Degrees of Freedom: 93 Total (i.e. Null);  92 Residual
## Null Deviance:       76.72 
## Residual Deviance: 65.36     AIC: 235.1
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 239.1776
## 
## $true_model_parameters$AICc
## [1] 239.6321
## 
## $true_model_parameters$BIC
## [1] 249.308
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 90
## 
## $true_model_parameters$null.deviance
## [1] 75.29118
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T2 ~ 1 + G * E - G
## <environment: 0x0000000015479148>
## 
## $crossover
## [1] 3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$diff_suscept_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##     3.23686      0.03679  
## 
## Degrees of Freedom: 92 Total (i.e. Null);  91 Residual
## Null Deviance:       75.29 
## Residual Deviance: 65.55     AIC: 237.4
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_T2  
##      1  
## 
## Degrees of Freedom: 93 Total (i.e. Null);  92 Residual
## Null Deviance:       83.15 
## Residual Deviance: 65.55     AIC: 235.4
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## crossover      ev_T2  
##     2.321      1.000  
## 
## Degrees of Freedom: 93 Total (i.e. Null);  91 Residual
## Null Deviance:       83.15 
## Residual Deviance: 65.55     AIC: 237.4
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 239.3994
## 
## $true_model_parameters$AICc
## [1] 239.854
## 
## $true_model_parameters$BIC
## [1] 249.5298
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 90
## 
## $true_model_parameters$null.deviance
## [1] 75.29118
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T2 ~ 1 + G * E - G - E
## <environment: 0x000000001bf3b5c0>
## 
## $crossover
## [1] 2.321332
## 
## $crossover_fixed
## [1] FALSE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$model_GandE_only
## 
## Call:  glm(formula = formula_model_GandE_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
## (Intercept)       hsc_T2        ev_T2  
##      3.1411      -0.0661       0.1799  
## 
## Degrees of Freedom: 92 Total (i.e. Null);  90 Residual
##   (21 observations deleted due to missingness)
## Null Deviance:       75.29 
## Residual Deviance: 66.7  AIC: 241
## 
## $fits$vantage_sensitivity_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##    2.260342     0.152608     0.005785  
## 
## Degrees of Freedom: 92 Total (i.e. Null);  90 Residual
## Null Deviance:       75.29 
## Residual Deviance: 66.92     AIC: 241.3
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_T2  
##      1  
## 
## Degrees of Freedom: 93 Total (i.e. Null);  92 Residual
## Null Deviance:       68.29 
## Residual Deviance: 66.92     AIC: 237.3
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T2  
##     1  
## 
## Degrees of Freedom: 93 Total (i.e. Null);  92 Residual
## Null Deviance:       77.32 
## Residual Deviance: 66.92     AIC: 237.3
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 241.3154
## 
## $true_model_parameters$AICc
## [1] 241.7699
## 
## $true_model_parameters$BIC
## [1] 251.4458
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 90
## 
## $true_model_parameters$null.deviance
## [1] 75.29118
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T2 ~ 1 + G * E - G
## <environment: 0x000000001c146bd8>
## 
## $crossover
## [1] -3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$diff_suscept_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##      3.0195      -0.3886       0.1103  
## 
## Degrees of Freedom: 92 Total (i.e. Null);  90 Residual
## Null Deviance:       75.29 
## Residual Deviance: 64.6  AIC: 238
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_T2  
##      1  
## 
## Degrees of Freedom: 93 Total (i.e. Null);  92 Residual
## Null Deviance:       153.6 
## Residual Deviance: 64.6  AIC: 234
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## crossover      ev_T2  
##     1.157      1.000  
## 
## Degrees of Freedom: 93 Total (i.e. Null);  91 Residual
## Null Deviance:       75.79 
## Residual Deviance: 64.6  AIC: 236
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 240.0366
## 
## $true_model_parameters$AICc
## [1] 240.7262
## 
## $true_model_parameters$BIC
## [1] 252.6996
## 
## $true_model_parameters$rank
## [1] 4
## 
## $true_model_parameters$df.residual
## [1] 89
## 
## $true_model_parameters$null.deviance
## [1] 75.29118
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T2 ~ 1 + G * E - G
## <environment: 0x000000001b3f0ed0>
## 
## $crossover
## [1] 1.157141
## 
## $crossover_fixed
## [1] FALSE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$model_E_only
## 
## Call:  glm(formula = formula_model_E_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
## (Intercept)        ev_T2  
##      2.8339       0.1752  
## 
## Degrees of Freedom: 93 Total (i.e. Null);  92 Residual
##   (20 observations deleted due to missingness)
## Null Deviance:       79.46 
## Residual Deviance: 71.7  AIC: 247.3
## 
## $fits$model_G_only
## 
## Call:  glm(formula = formula_model_G_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
## (Intercept)       hsc_T2  
##      3.4645      -0.1007  
## 
## Degrees of Freedom: 96 Total (i.e. Null);  95 Residual
##   (17 observations deleted due to missingness)
## Null Deviance:       76.58 
## Residual Deviance: 75.96     AIC: 257.6
## 
## $fits$model_intercept_only
## 
## Call:  glm(formula = formula_model_intercept_only, family = family, 
##     data = cbind(data, genes, env))
## 
## Coefficients:
## (Intercept)  
##       2.972  
## 
## Degrees of Freedom: 98 Total (i.e. Null);  98 Residual
##   (15 observations deleted due to missingness)
## Null Deviance:       81.04 
## Residual Deviance: 81.04     AIC: 265.1
## 
## 
## $results
##                                    BIC      crossover crossover 95%    
## Diathesis-stress STRONG            "245.05" "3"       ""               
## Vantage sensitivity STRONG         "247.92" "-3"      ""               
## Diathesis-stress WEAK              "249.31" "3"       ""               
## Differential susceptibility STRONG "249.53" "2.32"    "( 1.32 / 3.32 )"
## G + E only                         "251.13" NA        ""               
## Vantage sensitivity WEAK           "251.45" "-3"      ""               
## Differential susceptibility WEAK   "252.7"  "1.16"    "( 0.2 / 2.12 )" 
## E only                             "254.94" NA        ""               
## G only                             "265.29" NA        ""               
## Intercept only                     "270.32" NA        ""               
##                                    Within observable range?
## Diathesis-stress STRONG            ""                      
## Vantage sensitivity STRONG         ""                      
## Diathesis-stress WEAK              ""                      
## Differential susceptibility STRONG "No"                    
## G + E only                         ""                      
## Vantage sensitivity WEAK           ""                      
## Differential susceptibility WEAK   "Yes"                   
## E only                             ""                      
## G only                             ""                      
## Intercept only                     ""                      
##                                    % of observations below crossover
## Diathesis-stress STRONG            "0.849462365591398"              
## Vantage sensitivity STRONG         "0"                              
## Diathesis-stress WEAK              "0.849462365591398"              
## Differential susceptibility STRONG "0.720430107526882"              
## G + E only                         NA                               
## Vantage sensitivity WEAK           "0.021505376344086"              
## Differential susceptibility WEAK   "0.623655913978495"              
## E only                             NA                               
## G only                             NA                               
## Intercept only                     NA                               
## 
## $E_range
## [1] -3  3
# fits[[1]] is the best model (based on BIC)
summary(GxE_test_BIC$fits[[1]]) 
## $fit_main
## 
## Call:
## stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -1.67448  -0.60785  -0.00282   0.54120   2.22270  
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 3.356185   0.142247  23.594  < 2e-16 ***
## G:E         0.036180   0.009861   3.669  0.00041 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.7207549)
## 
##     Null deviance: 75.291  on 92  degrees of freedom
## Residual deviance: 65.589  on 91  degrees of freedom
## AIC: 237.45
## 
## Number of Fisher Scoring iterations: 2
## 
## 
## $fit_genes
## 
## Call:
## stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -1.67448  -0.60785  -0.00282   0.54120   2.22270  
## 
## Coefficients: (-1 not defined because of singularities)
##        Estimate Std. Error t value Pr(>|t|)    
## hsc_T2   1.0000     0.1687   5.928 5.42e-08 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.7207549)
## 
##     Null deviance: 75.291  on 93  degrees of freedom
## Residual deviance: 65.589  on 91  degrees of freedom
## AIC: 237.45
## 
## Number of Fisher Scoring iterations: 2
## 
## 
## $fit_env
## 
## Call:
## stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -1.68005  -0.61189  -0.00523   0.53456   2.22270  
## 
## Coefficients: (-1 not defined because of singularities)
##       Estimate Std. Error t value Pr(>|t|)    
## ev_T2   1.0000     0.2553   3.917 0.000173 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.7207329)
## 
##     Null deviance: 75.291  on 93  degrees of freedom
## Residual deviance: 65.587  on 91  degrees of freedom
## AIC: 237.45
## 
## Number of Fisher Scoring iterations: 2
plot(GxE_test_BIC$fits[[1]], xlim=c(-3,3), ylim=c(1,4), legend = "bottomright")

8-3. 3時点目の強い素因ストレスモデル

GxE_test_BIC = GxE_interaction_test(data=df, genes=df[,"hsc_T3", drop=FALSE], env=df[,"ev_T3", drop = FALSE], formula_noGxE = wb_T3 ~ 1, crossover = c("min","max"), criterion="BIC")
GxE_test_BIC
## $fits
## $fits$diathesis_stress_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##     3.35831      0.03701  
## 
## Degrees of Freedom: 101 Total (i.e. Null);  100 Residual
## Null Deviance:       89.66 
## Residual Deviance: 77.81     AIC: 267.9
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_T3  
##      1  
## 
## Degrees of Freedom: 102 Total (i.e. Null);  101 Residual
## Null Deviance:       111.1 
## Residual Deviance: 77.81     AIC: 265.9
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T3  
##     1  
## 
## Degrees of Freedom: 102 Total (i.e. Null);  101 Residual
## Null Deviance:       89.28 
## Residual Deviance: 77.8  AIC: 265.8
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 267.8513
## 
## $true_model_parameters$AICc
## [1] 268.0962
## 
## $true_model_parameters$BIC
## [1] 275.7262
## 
## $true_model_parameters$rank
## [1] 2
## 
## $true_model_parameters$df.residual
## [1] 100
## 
## $true_model_parameters$null.deviance
## [1] 89.66
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T3 ~ 1 + G * E - G - E
## <environment: 0x000000001546d450>
## 
## $crossover
## [1] 3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$diathesis_stress_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##     3.30962     -0.21011      0.07224  
## 
## Degrees of Freedom: 101 Total (i.e. Null);  99 Residual
## Null Deviance:       89.66 
## Residual Deviance: 77.23     AIC: 269.1
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_T3  
##      1  
## 
## Degrees of Freedom: 102 Total (i.e. Null);  101 Residual
## Null Deviance:       204.1 
## Residual Deviance: 77.23     AIC: 265.1
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T3  
##     1  
## 
## Degrees of Freedom: 102 Total (i.e. Null);  101 Residual
## Null Deviance:       88.04 
## Residual Deviance: 77.23     AIC: 265.1
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 269.0891
## 
## $true_model_parameters$AICc
## [1] 269.5015
## 
## $true_model_parameters$BIC
## [1] 279.589
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 99
## 
## $true_model_parameters$null.deviance
## [1] 89.66
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T3 ~ 1 + G * E - G
## <environment: 0x0000000018d5c890>
## 
## $crossover
## [1] 3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$model_E_only
## 
## Call:  glm(formula = formula_model_E_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
## (Intercept)        ev_T3  
##      2.7559       0.2036  
## 
## Degrees of Freedom: 102 Total (i.e. Null);  101 Residual
##   (11 observations deleted due to missingness)
## Null Deviance:       90.86 
## Residual Deviance: 79.67     AIC: 271.8
## 
## $fits$diff_suscept_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##     3.71943      0.03502  
## 
## Degrees of Freedom: 101 Total (i.e. Null);  100 Residual
## Null Deviance:       89.66 
## Residual Deviance: 77.55     AIC: 267.5
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_T3  
##      1  
## 
## Degrees of Freedom: 102 Total (i.e. Null);  101 Residual
## Null Deviance:       158.1 
## Residual Deviance: 77.55     AIC: 265.5
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## crossover      ev_T3  
##     5.087      1.000  
## 
## Degrees of Freedom: 102 Total (i.e. Null);  100 Residual
## Null Deviance:       158.1 
## Residual Deviance: 77.55     AIC: 267.5
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 269.5095
## 
## $true_model_parameters$AICc
## [1] 269.9219
## 
## $true_model_parameters$BIC
## [1] 280.0094
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 99
## 
## $true_model_parameters$null.deviance
## [1] 89.66
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T3 ~ 1 + G * E - G - E
## <environment: 0x000000001b72db10>
## 
## $crossover
## [1] 5.086837
## 
## $crossover_fixed
## [1] FALSE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$vantage_sensitivity_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##     2.29177      0.03155  
## 
## Degrees of Freedom: 101 Total (i.e. Null);  100 Residual
## Null Deviance:       89.66 
## Residual Deviance: 81.87     AIC: 273
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_T3  
##      1  
## 
## Degrees of Freedom: 102 Total (i.e. Null);  101 Residual
## Null Deviance:       127.4 
## Residual Deviance: 81.87     AIC: 271
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T3  
##     1  
## 
## Degrees of Freedom: 102 Total (i.e. Null);  101 Residual
## Null Deviance:       93.68 
## Residual Deviance: 81.64     AIC: 270.8
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 273.0448
## 
## $true_model_parameters$AICc
## [1] 273.2897
## 
## $true_model_parameters$BIC
## [1] 280.9197
## 
## $true_model_parameters$rank
## [1] 2
## 
## $true_model_parameters$df.residual
## [1] 100
## 
## $true_model_parameters$null.deviance
## [1] 89.66
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T3 ~ 1 + G * E - G - E
## <environment: 0x000000001c0c3310>
## 
## $crossover
## [1] -3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$model_GandE_only
## 
## Call:  glm(formula = formula_model_GandE_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
## (Intercept)       hsc_T3        ev_T3  
##      3.5771      -0.1527       0.1864  
## 
## Degrees of Freedom: 101 Total (i.e. Null);  99 Residual
##   (12 observations deleted due to missingness)
## Null Deviance:       89.66 
## Residual Deviance: 78.29     AIC: 270.5
## 
## $fits$vantage_sensitivity_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##     2.16989      0.29155     -0.01795  
## 
## Degrees of Freedom: 101 Total (i.e. Null);  99 Residual
## Null Deviance:       89.66 
## Residual Deviance: 79.24     AIC: 271.7
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_T3  
##      1  
## 
## Degrees of Freedom: 102 Total (i.e. Null);  101 Residual
## Null Deviance:       93.97 
## Residual Deviance: 79.24     AIC: 267.7
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T3  
##     1  
## 
## Degrees of Freedom: 102 Total (i.e. Null);  101 Residual
## Null Deviance:       90.49 
## Residual Deviance: 79.23     AIC: 267.7
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 271.7034
## 
## $true_model_parameters$AICc
## [1] 272.1158
## 
## $true_model_parameters$BIC
## [1] 282.2033
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 99
## 
## $true_model_parameters$null.deviance
## [1] 89.66
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T3 ~ 1 + G * E - G
## <environment: 0x000000001b891ff8>
## 
## $crossover
## [1] -3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$diff_suscept_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##      3.2702      -0.2356       0.0770  
## 
## Degrees of Freedom: 101 Total (i.e. Null);  99 Residual
## Null Deviance:       89.66 
## Residual Deviance: 77.22     AIC: 269.1
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_T3  
##      1  
## 
## Degrees of Freedom: 102 Total (i.e. Null);  101 Residual
## Null Deviance:       203.3 
## Residual Deviance: 77.22     AIC: 265.1
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## crossover      ev_T3  
##     2.769      1.000  
## 
## Degrees of Freedom: 102 Total (i.e. Null);  100 Residual
## Null Deviance:       103.6 
## Residual Deviance: 77.22     AIC: 267.1
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 271.08
## 
## $true_model_parameters$AICc
## [1] 271.705
## 
## $true_model_parameters$BIC
## [1] 284.2049
## 
## $true_model_parameters$rank
## [1] 4
## 
## $true_model_parameters$df.residual
## [1] 98
## 
## $true_model_parameters$null.deviance
## [1] 89.66
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T3 ~ 1 + G * E - G
## <environment: 0x000000001aa0a2b8>
## 
## $crossover
## [1] 2.76895
## 
## $crossover_fixed
## [1] FALSE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$model_G_only
## 
## Call:  glm(formula = formula_model_G_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
## (Intercept)       hsc_T3  
##      4.0307      -0.2128  
## 
## Degrees of Freedom: 103 Total (i.e. Null);  102 Residual
##   (10 observations deleted due to missingness)
## Null Deviance:       90.47 
## Residual Deviance: 87.9  AIC: 283.6
## 
## $fits$model_intercept_only
## 
## Call:  glm(formula = formula_model_intercept_only, family = family, 
##     data = cbind(data, genes, env))
## 
## Coefficients:
## (Intercept)  
##       2.899  
## 
## Degrees of Freedom: 104 Total (i.e. Null);  104 Residual
##   (9 observations deleted due to missingness)
## Null Deviance:       91.69 
## Residual Deviance: 91.69     AIC: 287.7
## 
## 
## $results
##                                    BIC      crossover crossover 95%    
## Diathesis-stress STRONG            "275.73" "3"       ""               
## Diathesis-stress WEAK              "279.59" "3"       ""               
## E only                             "279.75" NA        ""               
## Differential susceptibility STRONG "280.01" "5.09"    "( 4.11 / 6.06 )"
## Vantage sensitivity STRONG         "280.92" "-3"      ""               
## G + E only                         "280.98" NA        ""               
## Vantage sensitivity WEAK           "282.2"  "-3"      ""               
## Differential susceptibility WEAK   "284.2"  "2.77"    "( 1.78 / 3.76 )"
## G only                             "291.58" NA        ""               
## Intercept only                     "293.05" NA        ""               
##                                    Within observable range?
## Diathesis-stress STRONG            ""                      
## Diathesis-stress WEAK              ""                      
## E only                             ""                      
## Differential susceptibility STRONG "No"                    
## Vantage sensitivity STRONG         ""                      
## G + E only                         ""                      
## Vantage sensitivity WEAK           ""                      
## Differential susceptibility WEAK   "No"                    
## G only                             ""                      
## Intercept only                     ""                      
##                                    % of observations below crossover
## Diathesis-stress STRONG            "1"                              
## Diathesis-stress WEAK              "0.852941176470588"              
## E only                             NA                               
## Differential susceptibility STRONG "1"                              
## Vantage sensitivity STRONG         "0.0588235294117647"             
## G + E only                         NA                               
## Vantage sensitivity WEAK           "0.0588235294117647"             
## Differential susceptibility WEAK   "0.852941176470588"              
## G only                             NA                               
## Intercept only                     NA                               
## 
## $E_range
## [1] -3  3
# fits[[1]] is the best model (based on BIC)
summary(GxE_test_BIC$fits[[1]]) 
## $fit_main
## 
## Call:
## stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -2.55831  -0.56319  -0.02603   0.50907   2.10426  
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 3.358310   0.146356  22.946  < 2e-16 ***
## G:E         0.037006   0.009482   3.903 0.000173 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.7780962)
## 
##     Null deviance: 89.66  on 101  degrees of freedom
## Residual deviance: 77.81  on 100  degrees of freedom
## AIC: 267.85
## 
## Number of Fisher Scoring iterations: 2
## 
## 
## $fit_genes
## 
## Call:
## stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -2.55831  -0.56319  -0.02603   0.50907   2.10426  
## 
## Coefficients: (-1 not defined because of singularities)
##        Estimate Std. Error t value Pr(>|t|)    
## hsc_T3   1.0000     0.1529   6.539 2.64e-09 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.7780962)
## 
##     Null deviance: 89.66  on 102  degrees of freedom
## Residual deviance: 77.81  on 100  degrees of freedom
## AIC: 267.85
## 
## Number of Fisher Scoring iterations: 2
## 
## 
## $fit_env
## 
## Call:
## stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -2.5380  -0.5581  -0.0195   0.5102   2.1072  
## 
## Coefficients: (-1 not defined because of singularities)
##       Estimate Std. Error t value Pr(>|t|)    
## ev_T3   1.0000     0.2603   3.842 0.000215 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.7779687)
## 
##     Null deviance: 89.660  on 102  degrees of freedom
## Residual deviance: 77.797  on 100  degrees of freedom
## AIC: 267.85
## 
## Number of Fisher Scoring iterations: 2
plot(GxE_test_BIC$fits[[1]], xlim=c(-3,3), ylim=c(1,4), legend = "bottomright")

8-4. 4時点目の弱いヴァンテージ感受性モデル

GxE_test_BIC = GxE_interaction_test(data=df, genes=df[,"hsc_T4", drop=FALSE], env=df[,"ev_T4", drop = FALSE], formula_noGxE = wb_T4 ~ 1, crossover = c("min","max"), criterion="BIC")
GxE_test_BIC
## $fits
## $fits$vantage_sensitivity_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##     2.19774      0.63883     -0.08784  
## 
## Degrees of Freedom: 98 Total (i.e. Null);  96 Residual
## Null Deviance:       100.6 
## Residual Deviance: 87.93     AIC: 277.2
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_T4  
##      1  
## 
## Degrees of Freedom: 99 Total (i.e. Null);  98 Residual
## Null Deviance:       452.1 
## Residual Deviance: 87.93     AIC: 273.2
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T4  
##     1  
## 
## Degrees of Freedom: 99 Total (i.e. Null);  98 Residual
## Null Deviance:       97.51 
## Residual Deviance: 87.92     AIC: 273.2
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 277.2124
## 
## $true_model_parameters$AICc
## [1] 277.638
## 
## $true_model_parameters$BIC
## [1] 287.5929
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 96
## 
## $true_model_parameters$null.deviance
## [1] 100.5818
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T4 ~ 1 + G * E - G
## <environment: 0x000000001ad337a8>
## 
## $crossover
## [1] -3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$model_GandE_only
## 
## Call:  glm(formula = formula_model_GandE_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
## (Intercept)       hsc_T4        ev_T4  
##      4.5968      -0.3611       0.1952  
## 
## Degrees of Freedom: 98 Total (i.e. Null);  96 Residual
##   (15 observations deleted due to missingness)
## Null Deviance:       100.6 
## Residual Deviance: 88.12     AIC: 277.4
## 
## $fits$diff_suscept_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##     4.74160      0.03604  
## 
## Degrees of Freedom: 98 Total (i.e. Null);  97 Residual
## Null Deviance:       100.6 
## Residual Deviance: 88.83     AIC: 276.2
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_T4  
##      1  
## 
## Degrees of Freedom: 99 Total (i.e. Null);  98 Residual
## Null Deviance:       439.7 
## Residual Deviance: 88.83     AIC: 274.2
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## crossover      ev_T4  
##     10.78       1.00  
## 
## Degrees of Freedom: 99 Total (i.e. Null);  97 Residual
## Null Deviance:       439.7 
## Residual Deviance: 88.83     AIC: 276.2
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 278.2198
## 
## $true_model_parameters$AICc
## [1] 278.6453
## 
## $true_model_parameters$BIC
## [1] 288.6003
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 96
## 
## $true_model_parameters$null.deviance
## [1] 100.5818
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T4 ~ 1 + G * E - G - E
## <environment: 0x000000001ac98eb0>
## 
## $crossover
## [1] 10.78444
## 
## $crossover_fixed
## [1] FALSE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$diathesis_stress_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##     3.31028      0.03848  
## 
## Degrees of Freedom: 98 Total (i.e. Null);  97 Residual
## Null Deviance:       100.6 
## Residual Deviance: 93.17     AIC: 280.9
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_T4  
##      1  
## 
## Degrees of Freedom: 99 Total (i.e. Null);  98 Residual
## Null Deviance:       118 
## Residual Deviance: 93.17     AIC: 278.9
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T4  
##     1  
## 
## Degrees of Freedom: 99 Total (i.e. Null);  98 Residual
## Null Deviance:       100.6 
## Residual Deviance: 92.88     AIC: 278.6
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 280.943
## 
## $true_model_parameters$AICc
## [1] 281.1957
## 
## $true_model_parameters$BIC
## [1] 288.7284
## 
## $true_model_parameters$rank
## [1] 2
## 
## $true_model_parameters$df.residual
## [1] 97
## 
## $true_model_parameters$null.deviance
## [1] 100.5818
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T4 ~ 1 + G * E - G - E
## <environment: 0x0000000018711ca0>
## 
## $crossover
## [1] 3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$diff_suscept_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##     1.61129      0.46381     -0.05298  
## 
## Degrees of Freedom: 98 Total (i.e. Null);  96 Residual
## Null Deviance:       100.6 
## Residual Deviance: 87.74     AIC: 277
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_T4  
##      1  
## 
## Degrees of Freedom: 99 Total (i.e. Null);  98 Residual
## Null Deviance:       465.3 
## Residual Deviance: 87.74     AIC: 273
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## crossover      ev_T4  
##    -5.958      1.000  
## 
## Degrees of Freedom: 99 Total (i.e. Null);  97 Residual
## Null Deviance:       262.7 
## Residual Deviance: 87.74     AIC: 275
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 278.9991
## 
## $true_model_parameters$AICc
## [1] 279.6443
## 
## $true_model_parameters$BIC
## [1] 291.9747
## 
## $true_model_parameters$rank
## [1] 4
## 
## $true_model_parameters$df.residual
## [1] 95
## 
## $true_model_parameters$null.deviance
## [1] 100.5818
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T4 ~ 1 + G * E - G
## <environment: 0x0000000013cdc7f8>
## 
## $crossover
## [1] -5.95753
## 
## $crossover_fixed
## [1] FALSE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$diathesis_stress_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##     3.28953     -0.28044      0.09128  
## 
## Degrees of Freedom: 98 Total (i.e. Null);  96 Residual
## Null Deviance:       100.6 
## Residual Deviance: 92.01     AIC: 281.7
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_T4  
##      1  
## 
## Degrees of Freedom: 99 Total (i.e. Null);  98 Residual
## Null Deviance:       231.7 
## Residual Deviance: 92.01     AIC: 277.7
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T4  
##     1  
## 
## Degrees of Freedom: 99 Total (i.e. Null);  98 Residual
## Null Deviance:       98.68 
## Residual Deviance: 91.49     AIC: 277.1
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 281.7058
## 
## $true_model_parameters$AICc
## [1] 282.1313
## 
## $true_model_parameters$BIC
## [1] 292.0863
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 96
## 
## $true_model_parameters$null.deviance
## [1] 100.5818
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T4 ~ 1 + G * E - G
## <environment: 0x000000001c40e638>
## 
## $crossover
## [1] 3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$vantage_sensitivity_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##     2.61026      0.01384  
## 
## Degrees of Freedom: 98 Total (i.e. Null);  97 Residual
## Null Deviance:       100.6 
## Residual Deviance: 99.34     AIC: 287.3
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_T4  
##      1  
## 
## Degrees of Freedom: 99 Total (i.e. Null);  98 Residual
## Null Deviance:       108.4 
## Residual Deviance: 99.34     AIC: 285.3
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T4  
##     1  
## 
## Degrees of Freedom: 99 Total (i.e. Null);  98 Residual
## Null Deviance:       102.5 
## Residual Deviance: 98.8  AIC: 284.7
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 287.2897
## 
## $true_model_parameters$AICc
## [1] 287.5424
## 
## $true_model_parameters$BIC
## [1] 295.0751
## 
## $true_model_parameters$rank
## [1] 2
## 
## $true_model_parameters$df.residual
## [1] 97
## 
## $true_model_parameters$null.deviance
## [1] 100.5818
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T4 ~ 1 + G * E - G - E
## <environment: 0x000000001b948958>
## 
## $crossover
## [1] -3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$model_E_only
## 
## Call:  glm(formula = formula_model_E_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
## (Intercept)        ev_T4  
##      2.7062       0.2031  
## 
## Degrees of Freedom: 100 Total (i.e. Null);  99 Residual
##   (13 observations deleted due to missingness)
## Null Deviance:       112.3 
## Residual Deviance: 104.1     AIC: 295.7
## 
## $fits$model_G_only
## 
## Call:  glm(formula = formula_model_G_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
## (Intercept)       hsc_T4  
##       4.059       -0.231  
## 
## Degrees of Freedom: 103 Total (i.e. Null);  102 Residual
##   (10 observations deleted due to missingness)
## Null Deviance:       107.4 
## Residual Deviance: 103.8     AIC: 301
## 
## $fits$model_intercept_only
## 
## Call:  glm(formula = formula_model_intercept_only, family = family, 
##     data = cbind(data, genes, env))
## 
## Coefficients:
## (Intercept)  
##       2.864  
## 
## Degrees of Freedom: 105 Total (i.e. Null);  105 Residual
##   (8 observations deleted due to missingness)
## Null Deviance:       119.1 
## Residual Deviance: 119.1     AIC: 317.2
## 
## 
## $results
##                                    BIC      crossover crossover 95%      
## Vantage sensitivity WEAK           "287.59" "-3"      ""                 
## G + E only                         "287.8"  NA        ""                 
## Differential susceptibility STRONG "288.6"  "10.78"   "( 9.58 / 11.99 )" 
## Diathesis-stress STRONG            "288.73" "3"       ""                 
## Differential susceptibility WEAK   "291.97" "-5.96"   "( -7.07 / -4.85 )"
## Diathesis-stress WEAK              "292.09" "3"       ""                 
## Vantage sensitivity STRONG         "295.08" "-3"      ""                 
## E only                             "303.51" NA        ""                 
## G only                             "308.92" NA        ""                 
## Intercept only                     "322.48" NA        ""                 
##                                    Within observable range?
## Vantage sensitivity WEAK           ""                      
## G + E only                         ""                      
## Differential susceptibility STRONG "No"                    
## Diathesis-stress STRONG            ""                      
## Differential susceptibility WEAK   "No"                    
## Diathesis-stress WEAK              ""                      
## Vantage sensitivity STRONG         ""                      
## E only                             ""                      
## G only                             ""                      
## Intercept only                     ""                      
##                                    % of observations below crossover
## Vantage sensitivity WEAK           "0"                              
## G + E only                         NA                               
## Differential susceptibility STRONG "1"                              
## Diathesis-stress STRONG            "0.868686868686869"              
## Differential susceptibility WEAK   "0"                              
## Diathesis-stress WEAK              "0.868686868686869"              
## Vantage sensitivity STRONG         "0.0303030303030303"             
## E only                             NA                               
## G only                             NA                               
## Intercept only                     NA                               
## 
## $E_range
## [1] -3  3
# fits[[1]] is the best model (based on BIC)
summary(GxE_test_BIC$fits[[1]]) 
## $fit_main
## 
## Call:
## stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.8888  -0.5629  -0.1444   0.5825   2.3176  
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  2.19774    0.28466   7.720  1.1e-11 ***
## E            0.63883    0.18101   3.529 0.000642 ***
## G:E         -0.08784    0.03117  -2.818 0.005860 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.9159551)
## 
##     Null deviance: 100.582  on 98  degrees of freedom
## Residual deviance:  87.932  on 96  degrees of freedom
## AIC: 277.21
## 
## Number of Fisher Scoring iterations: 2
## 
## 
## $fit_genes
## 
## Call:
## stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.8888  -0.5629  -0.1444   0.5825   2.3176  
## 
## Coefficients: (-2 not defined because of singularities)
##        Estimate Std. Error t value Pr(>|t|)    
## hsc_T4  1.00000    0.05015   19.94   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.9159551)
## 
##     Null deviance: 100.582  on 99  degrees of freedom
## Residual deviance:  87.932  on 96  degrees of freedom
## AIC: 277.21
## 
## Number of Fisher Scoring iterations: 2
## 
## 
## $fit_env
## 
## Call:
## stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.8888  -0.5509  -0.1357   0.5825   2.3176  
## 
## Coefficients: (-2 not defined because of singularities)
##       Estimate Std. Error t value Pr(>|t|)   
## ev_T4    1.000      0.309   3.236  0.00166 **
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.9158518)
## 
##     Null deviance: 100.582  on 99  degrees of freedom
## Residual deviance:  87.922  on 96  degrees of freedom
## AIC: 277.21
## 
## Number of Fisher Scoring iterations: 2
plot(GxE_test_BIC$fits[[1]], xlim=c(-3,3), ylim=c(1,4), legend = "bottomright")

8-5. 1か月間の強い素因ストレスモデル

GxE_test_BIC = GxE_interaction_test(data=df, genes=df[,"hsc_onemonth", drop=FALSE], env=df[,"ev_onemonth", drop = FALSE], formula_noGxE = wb_onemonth ~ 1, crossover = c("min","max"), criterion="BIC")
GxE_test_BIC
## $fits
## $fits$diathesis_stress_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##     3.45817      0.05274  
## 
## Degrees of Freedom: 78 Total (i.e. Null);  77 Residual
## Null Deviance:       51.04 
## Residual Deviance: 44.92     AIC: 185.6
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_onemonth  
##            1  
## 
## Degrees of Freedom: 79 Total (i.e. Null);  78 Residual
## Null Deviance:       74.99 
## Residual Deviance: 44.92     AIC: 183.6
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_onemonth  
##           1  
## 
## Degrees of Freedom: 79 Total (i.e. Null);  78 Residual
## Null Deviance:       54.83 
## Residual Deviance: 44.92     AIC: 183.6
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 185.5997
## 
## $true_model_parameters$AICc
## [1] 185.9197
## 
## $true_model_parameters$BIC
## [1] 192.7081
## 
## $true_model_parameters$rank
## [1] 2
## 
## $true_model_parameters$df.residual
## [1] 77
## 
## $true_model_parameters$null.deviance
## [1] 51.04044
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_onemonth ~ 1 + G * E - G - E
## <environment: 0x000000001c74e098>
## 
## $crossover
## [1] 2.875
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$diathesis_stress_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##     3.41797     -0.24573      0.09639  
## 
## Degrees of Freedom: 78 Total (i.e. Null);  76 Residual
## Null Deviance:       51.04 
## Residual Deviance: 44.59     AIC: 187
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_onemonth  
##            1  
## 
## Degrees of Freedom: 79 Total (i.e. Null);  78 Residual
## Null Deviance:       145 
## Residual Deviance: 44.59     AIC: 183
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_onemonth  
##           1  
## 
## Degrees of Freedom: 79 Total (i.e. Null);  78 Residual
## Null Deviance:       55.01 
## Residual Deviance: 44.58     AIC: 183
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 187.0167
## 
## $true_model_parameters$AICc
## [1] 187.5572
## 
## $true_model_parameters$BIC
## [1] 196.4945
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 76
## 
## $true_model_parameters$null.deviance
## [1] 51.04044
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_onemonth ~ 1 + G * E - G
## <environment: 0x000000001bc0cfe0>
## 
## $crossover
## [1] 2.875
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$vantage_sensitivity_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##     2.39658      0.03965  
## 
## Degrees of Freedom: 78 Total (i.e. Null);  77 Residual
## Null Deviance:       51.04 
## Residual Deviance: 47.27     AIC: 189.6
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_onemonth  
##            1  
## 
## Degrees of Freedom: 79 Total (i.e. Null);  78 Residual
## Null Deviance:       71.67 
## Residual Deviance: 47.27     AIC: 187.6
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_onemonth  
##           1  
## 
## Degrees of Freedom: 79 Total (i.e. Null);  78 Residual
## Null Deviance:       54.26 
## Residual Deviance: 47.22     AIC: 187.5
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 189.6217
## 
## $true_model_parameters$AICc
## [1] 189.9417
## 
## $true_model_parameters$BIC
## [1] 196.73
## 
## $true_model_parameters$rank
## [1] 2
## 
## $true_model_parameters$df.residual
## [1] 77
## 
## $true_model_parameters$null.deviance
## [1] 51.04044
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_onemonth ~ 1 + G * E - G - E
## <environment: 0x000000001b088148>
## 
## $crossover
## [1] -1.625
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$diff_suscept_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##     3.68529      0.05152  
## 
## Degrees of Freedom: 78 Total (i.e. Null);  77 Residual
## Null Deviance:       51.04 
## Residual Deviance: 44.85     AIC: 185.5
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_onemonth  
##            1  
## 
## Degrees of Freedom: 79 Total (i.e. Null);  78 Residual
## Null Deviance:       98.82 
## Residual Deviance: 44.85     AIC: 183.5
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
##   crossover  ev_onemonth  
##       3.773        1.000  
## 
## Degrees of Freedom: 79 Total (i.e. Null);  77 Residual
## Null Deviance:       98.82 
## Residual Deviance: 44.85     AIC: 185.5
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 187.4712
## 
## $true_model_parameters$AICc
## [1] 188.0117
## 
## $true_model_parameters$BIC
## [1] 196.9489
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 76
## 
## $true_model_parameters$null.deviance
## [1] 51.04044
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_onemonth ~ 1 + G * E - G - E
## <environment: 0x000000001a7dd0f0>
## 
## $crossover
## [1] 3.773169
## 
## $crossover_fixed
## [1] FALSE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$model_GandE_only
## 
## Call:  glm(formula = formula_model_GandE_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
##  (Intercept)  hsc_onemonth   ev_onemonth  
##       3.4163       -0.1412        0.2601  
## 
## Degrees of Freedom: 78 Total (i.e. Null);  76 Residual
##   (35 observations deleted due to missingness)
## Null Deviance:       51.04 
## Residual Deviance: 45.38     AIC: 188.4
## 
## $fits$vantage_sensitivity_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##     2.26155      0.38840     -0.02469  
## 
## Degrees of Freedom: 78 Total (i.e. Null);  76 Residual
## Null Deviance:       51.04 
## Residual Deviance: 45.91     AIC: 189.3
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_onemonth  
##            1  
## 
## Degrees of Freedom: 79 Total (i.e. Null);  78 Residual
## Null Deviance:       55.37 
## Residual Deviance: 45.91     AIC: 185.3
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_onemonth  
##           1  
## 
## Degrees of Freedom: 79 Total (i.e. Null);  78 Residual
## Null Deviance:       54.65 
## Residual Deviance: 45.91     AIC: 185.3
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 189.3168
## 
## $true_model_parameters$AICc
## [1] 189.8573
## 
## $true_model_parameters$BIC
## [1] 198.7946
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 76
## 
## $true_model_parameters$null.deviance
## [1] 51.04044
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_onemonth ~ 1 + G * E - G
## <environment: 0x000000001a77a768>
## 
## $crossover
## [1] -1.625
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$diff_suscept_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##      3.1659      -0.5786       0.1596  
## 
## Degrees of Freedom: 78 Total (i.e. Null);  76 Residual
## Null Deviance:       51.04 
## Residual Deviance: 44.39     AIC: 186.7
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_onemonth  
##            1  
## 
## Degrees of Freedom: 79 Total (i.e. Null);  78 Residual
## Null Deviance:       157.7 
## Residual Deviance: 44.39     AIC: 182.7
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
##   crossover  ev_onemonth  
##       1.909        1.000  
## 
## Degrees of Freedom: 79 Total (i.e. Null);  77 Residual
## Null Deviance:       56.31 
## Residual Deviance: 44.39     AIC: 184.7
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 188.6542
## 
## $true_model_parameters$AICc
## [1] 189.4761
## 
## $true_model_parameters$BIC
## [1] 200.5014
## 
## $true_model_parameters$rank
## [1] 4
## 
## $true_model_parameters$df.residual
## [1] 75
## 
## $true_model_parameters$null.deviance
## [1] 51.04044
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_onemonth ~ 1 + G * E - G
## <environment: 0x0000000017e9ef20>
## 
## $crossover
## [1] 1.909142
## 
## $crossover_fixed
## [1] FALSE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$model_E_only
## 
## Call:  glm(formula = formula_model_E_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
## (Intercept)  ev_onemonth  
##      2.6818       0.2749  
## 
## Degrees of Freedom: 81 Total (i.e. Null);  80 Residual
##   (32 observations deleted due to missingness)
## Null Deviance:       53.64 
## Residual Deviance: 47.87     AIC: 194.6
## 
## $fits$model_G_only
## 
## Call:  glm(formula = formula_model_G_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
##  (Intercept)  hsc_onemonth  
##       3.6881       -0.1496  
## 
## Degrees of Freedom: 83 Total (i.e. Null);  82 Residual
##   (30 observations deleted due to missingness)
## Null Deviance:       52.99 
## Residual Deviance: 52.12     AIC: 204.3
## 
## $fits$model_intercept_only
## 
## Call:  glm(formula = formula_model_intercept_only, family = family, 
##     data = cbind(data, genes, env))
## 
## Coefficients:
## (Intercept)  
##       2.923  
## 
## Degrees of Freedom: 87 Total (i.e. Null);  87 Residual
##   (26 observations deleted due to missingness)
## Null Deviance:       55.8 
## Residual Deviance: 55.8  AIC: 213.6
## 
## 
## $results
##                                    BIC      crossover crossover 95%    
## Diathesis-stress STRONG            "192.71" "2.88"    ""               
## Diathesis-stress WEAK              "196.49" "2.87"    ""               
## Vantage sensitivity STRONG         "196.73" "-1.63"   ""               
## Differential susceptibility STRONG "196.95" "3.77"    "( 2.94 / 4.6 )" 
## G + E only                         "197.87" NA        ""               
## Vantage sensitivity WEAK           "198.79" "-1.62"   ""               
## Differential susceptibility WEAK   "200.5"  "1.91"    "( 1.08 / 2.73 )"
## E only                             "201.79" NA        ""               
## G only                             "211.58" NA        ""               
## Intercept only                     "218.6"  NA        ""               
##                                    Within observable range?
## Diathesis-stress STRONG            ""                      
## Diathesis-stress WEAK              ""                      
## Vantage sensitivity STRONG         ""                      
## Differential susceptibility STRONG "No"                    
## G + E only                         ""                      
## Vantage sensitivity WEAK           ""                      
## Differential susceptibility WEAK   "Yes"                   
## E only                             ""                      
## G only                             ""                      
## Intercept only                     ""                      
##                                    % of observations below crossover
## Diathesis-stress STRONG            "1"                              
## Diathesis-stress WEAK              "1"                              
## Vantage sensitivity STRONG         "0"                              
## Differential susceptibility STRONG "1"                              
## G + E only                         NA                               
## Vantage sensitivity WEAK           "0.0126582278481013"             
## Differential susceptibility WEAK   "0.873417721518987"              
## E only                             NA                               
## G only                             NA                               
## Intercept only                     NA                               
## 
## $E_range
## [1] -1.625  2.875
# fits[[1]] is the best model (based on BIC)
summary(GxE_test_BIC$fits[[1]]) 
## $fit_main
## 
## Call:
## stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.7250  -0.5312  -0.1335   0.4739   1.7612  
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  3.45817    0.19053  18.150  < 2e-16 ***
## G:E          0.05274    0.01629   3.238  0.00178 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.583436)
## 
##     Null deviance: 51.040  on 78  degrees of freedom
## Residual deviance: 44.925  on 77  degrees of freedom
## AIC: 185.6
## 
## Number of Fisher Scoring iterations: 2
## 
## 
## $fit_genes
## 
## Call:
## stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.7250  -0.5312  -0.1335   0.4739   1.7612  
## 
## Coefficients: (-1 not defined because of singularities)
##              Estimate Std. Error t value Pr(>|t|)    
## hsc_onemonth   1.0000     0.1393   7.178 3.81e-10 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.583436)
## 
##     Null deviance: 51.040  on 79  degrees of freedom
## Residual deviance: 44.925  on 77  degrees of freedom
## AIC: 185.6
## 
## Number of Fisher Scoring iterations: 2
## 
## 
## $fit_env
## 
## Call:
## stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.7164  -0.5126  -0.1209   0.4796   1.7620  
## 
## Coefficients: (-1 not defined because of singularities)
##             Estimate Std. Error t value Pr(>|t|)    
## ev_onemonth   1.0000     0.2426   4.122 9.37e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.5833644)
## 
##     Null deviance: 51.040  on 79  degrees of freedom
## Residual deviance: 44.919  on 77  degrees of freedom
## AIC: 185.6
## 
## Number of Fisher Scoring iterations: 2
plot(GxE_test_BIC$fits[[1]], xlim=c(-3,3), ylim=c(1,4), legend = "bottomright")

8-6. 追加分析の2時点目：強い素因ストレスモデル

GxE_test_BIC = GxE_interaction_test(data=df, genes=df[,"hsc_T1", drop=FALSE], env=df[,"ev_T1", drop = FALSE], formula_noGxE = wb_T2 ~ 1, crossover = c("min","max"), criterion="BIC")
GxE_test_BIC
## $fits
## $fits$diathesis_stress_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##     3.23329      0.02584  
## 
## Degrees of Freedom: 96 Total (i.e. Null);  95 Residual
## Null Deviance:       80.99 
## Residual Deviance: 76.86     AIC: 258.7
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_T1  
##      1  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  96 Residual
## Null Deviance:       87.76 
## Residual Deviance: 76.86     AIC: 256.7
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T1  
##     1  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  96 Residual
## Null Deviance:       82.19 
## Residual Deviance: 76.86     AIC: 256.7
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 258.6969
## 
## $true_model_parameters$AICc
## [1] 258.955
## 
## $true_model_parameters$BIC
## [1] 266.4211
## 
## $true_model_parameters$rank
## [1] 2
## 
## $true_model_parameters$df.residual
## [1] 95
## 
## $true_model_parameters$null.deviance
## [1] 80.98722
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T2 ~ 1 + G * E - G - E
## <environment: 0x000000001c08f680>
## 
## $crossover
## [1] 3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$vantage_sensitivity_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##      2.5538       0.0209  
## 
## Degrees of Freedom: 96 Total (i.e. Null);  95 Residual
## Null Deviance:       80.99 
## Residual Deviance: 78.15     AIC: 260.3
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_T1  
##      1  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  96 Residual
## Null Deviance:       97.72 
## Residual Deviance: 78.15     AIC: 258.3
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T1  
##     1  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  96 Residual
## Null Deviance:       82.69 
## Residual Deviance: 78.08     AIC: 258.2
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 260.3175
## 
## $true_model_parameters$AICc
## [1] 260.5755
## 
## $true_model_parameters$BIC
## [1] 268.0416
## 
## $true_model_parameters$rank
## [1] 2
## 
## $true_model_parameters$df.residual
## [1] 95
## 
## $true_model_parameters$null.deviance
## [1] 80.98722
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T2 ~ 1 + G * E - G - E
## <environment: 0x000000001ab451e8>
## 
## $crossover
## [1] -3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$model_E_only
## 
## Call:  glm(formula = formula_model_E_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
## (Intercept)        ev_T1  
##      2.8403       0.1345  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  96 Residual
##   (16 observations deleted due to missingness)
## Null Deviance:       81.04 
## Residual Deviance: 77    AIC: 260.5
## 
## $fits$model_intercept_only
## 
## Call:  glm(formula = formula_model_intercept_only, family = family, 
##     data = cbind(data, genes, env))
## 
## Coefficients:
## (Intercept)  
##       2.972  
## 
## Degrees of Freedom: 98 Total (i.e. Null);  98 Residual
##   (15 observations deleted due to missingness)
## Null Deviance:       81.04 
## Residual Deviance: 81.04     AIC: 265.1
## 
## $fits$model_GandE_only
## 
## Call:  glm(formula = formula_model_GandE_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
## (Intercept)       hsc_T1        ev_T1  
##     3.11304     -0.05468      0.13309  
## 
## Degrees of Freedom: 96 Total (i.e. Null);  94 Residual
##   (17 observations deleted due to missingness)
## Null Deviance:       80.99 
## Residual Deviance: 76.76     AIC: 260.6
## 
## $fits$vantage_sensitivity_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##     2.43476      0.19040     -0.01124  
## 
## Degrees of Freedom: 96 Total (i.e. Null);  94 Residual
## Null Deviance:       80.99 
## Residual Deviance: 76.77     AIC: 260.6
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_T1  
##      1  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  96 Residual
## Null Deviance:       82.43 
## Residual Deviance: 76.77     AIC: 256.6
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T1  
##     1  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  96 Residual
## Null Deviance:       82.47 
## Residual Deviance: 76.77     AIC: 256.6
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 260.5904
## 
## $true_model_parameters$AICc
## [1] 261.0252
## 
## $true_model_parameters$BIC
## [1] 270.8893
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 94
## 
## $true_model_parameters$null.deviance
## [1] 80.98722
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T2 ~ 1 + G * E - G
## <environment: 0x0000000013eb3b80>
## 
## $crossover
## [1] -3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$diathesis_stress_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##     3.23942      0.04910      0.01674  
## 
## Degrees of Freedom: 96 Total (i.e. Null);  94 Residual
## Null Deviance:       80.99 
## Residual Deviance: 76.83     AIC: 260.7
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_T1  
##      1  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  96 Residual
## Null Deviance:       81.41 
## Residual Deviance: 76.83     AIC: 256.7
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T1  
##     1  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  96 Residual
## Null Deviance:       82.33 
## Residual Deviance: 76.83     AIC: 256.7
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 260.6654
## 
## $true_model_parameters$AICc
## [1] 261.1002
## 
## $true_model_parameters$BIC
## [1] 270.9642
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 94
## 
## $true_model_parameters$null.deviance
## [1] 80.98722
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T2 ~ 1 + G * E - G
## <environment: 0x000000001b80efa8>
## 
## $crossover
## [1] 3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$diff_suscept_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##     3.28927      0.02559  
## 
## Degrees of Freedom: 96 Total (i.e. Null);  95 Residual
## Null Deviance:       80.99 
## Residual Deviance: 76.85     AIC: 258.7
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_T1  
##      1  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  96 Residual
## Null Deviance:       90.93 
## Residual Deviance: 76.85     AIC: 256.7
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## crossover      ev_T1  
##     3.456      1.000  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  95 Residual
## Null Deviance:       90.93 
## Residual Deviance: 76.85     AIC: 258.7
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 260.6883
## 
## $true_model_parameters$AICc
## [1] 261.1231
## 
## $true_model_parameters$BIC
## [1] 270.9872
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 94
## 
## $true_model_parameters$null.deviance
## [1] 80.98722
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T2 ~ 1 + G * E - G - E
## <environment: 0x0000000012ea8170>
## 
## $crossover
## [1] 3.456072
## 
## $crossover_fixed
## [1] FALSE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$model_G_only
## 
## Call:  glm(formula = formula_model_G_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
## (Intercept)       hsc_T1  
##     3.34520     -0.07507  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  96 Residual
##   (16 observations deleted due to missingness)
## Null Deviance:       80.99 
## Residual Deviance: 80.68     AIC: 265.1
## 
## $fits$diff_suscept_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##   -9.224019     0.136114    -0.000595  
## 
## Degrees of Freedom: 96 Total (i.e. Null);  94 Residual
## Null Deviance:       80.99 
## Residual Deviance: 76.76     AIC: 260.6
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_T1  
##      1  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  96 Residual
## Null Deviance:       84.16 
## Residual Deviance: 76.76     AIC: 256.6
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## crossover      ev_T1  
##    -90.61       1.00  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  95 Residual
## Null Deviance:       14500 
## Residual Deviance: 76.76     AIC: 258.6
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 262.5684
## 
## $true_model_parameters$AICc
## [1] 263.2277
## 
## $true_model_parameters$BIC
## [1] 275.4419
## 
## $true_model_parameters$rank
## [1] 4
## 
## $true_model_parameters$df.residual
## [1] 93
## 
## $true_model_parameters$null.deviance
## [1] 80.98722
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T2 ~ 1 + G * E - G
## <environment: 0x0000000018869560>
## 
## $crossover
## [1] -90.6085
## 
## $crossover_fixed
## [1] FALSE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## 
## $results
##                                    BIC      crossover crossover 95%        
## Diathesis-stress STRONG            "266.42" "3"       ""                   
## Vantage sensitivity STRONG         "268.04" "-3"      ""                   
## E only                             "268.23" NA        ""                   
## Intercept only                     "270.32" NA        ""                   
## G + E only                         "270.87" NA        ""                   
## Vantage sensitivity WEAK           "270.89" "-3"      ""                   
## Diathesis-stress WEAK              "270.96" "3"       ""                   
## Differential susceptibility STRONG "270.99" "3.46"    "( 1.83 / 5.08 )"    
## G only                             "272.81" NA        ""                   
## Differential susceptibility WEAK   "275.44" "-90.61"  "( -92.21 / -89.01 )"
##                                    Within observable range?
## Diathesis-stress STRONG            ""                      
## Vantage sensitivity STRONG         ""                      
## E only                             ""                      
## Intercept only                     ""                      
## G + E only                         ""                      
## Vantage sensitivity WEAK           ""                      
## Diathesis-stress WEAK              ""                      
## Differential susceptibility STRONG "No"                    
## G only                             ""                      
## Differential susceptibility WEAK   "No"                    
##                                    % of observations below crossover
## Diathesis-stress STRONG            "1"                              
## Vantage sensitivity STRONG         "0.0103092783505155"             
## E only                             NA                               
## Intercept only                     NA                               
## G + E only                         NA                               
## Vantage sensitivity WEAK           "0.0103092783505155"             
## Diathesis-stress WEAK              "1"                              
## Differential susceptibility STRONG "1"                              
## G only                             NA                               
## Differential susceptibility WEAK   "0"                              
## 
## $E_range
## [1] -3  3
# fits[[1]] is the best model (based on BIC)
summary(GxE_test_BIC$fits[[1]]) 
## $fit_main
## 
## Call:
## stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -2.23329  -0.57665  -0.00329   0.52958   2.11020  
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  3.23329    0.14838  21.790   <2e-16 ***
## G:E          0.02584    0.01144   2.259   0.0262 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.8090294)
## 
##     Null deviance: 80.987  on 96  degrees of freedom
## Residual deviance: 76.858  on 95  degrees of freedom
## AIC: 258.7
## 
## Number of Fisher Scoring iterations: 2
## 
## 
## $fit_genes
## 
## Call:
## stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -2.23329  -0.57665  -0.00329   0.52958   2.11020  
## 
## Coefficients: (-1 not defined because of singularities)
##        Estimate Std. Error t value Pr(>|t|)    
## hsc_T1   1.0000     0.2724   3.671 0.000399 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.8090294)
## 
##     Null deviance: 80.987  on 97  degrees of freedom
## Residual deviance: 76.858  on 95  degrees of freedom
## AIC: 258.7
## 
## Number of Fisher Scoring iterations: 2
## 
## 
## $fit_env
## 
## Call:
## stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -2.23037  -0.57428  -0.00233   0.53018   2.11077  
## 
## Coefficients: (-1 not defined because of singularities)
##       Estimate Std. Error t value Pr(>|t|)  
## ev_T1   1.0000     0.3895   2.567   0.0118 *
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.8090254)
## 
##     Null deviance: 80.987  on 97  degrees of freedom
## Residual deviance: 76.857  on 95  degrees of freedom
## AIC: 258.7
## 
## Number of Fisher Scoring iterations: 2
plot(GxE_test_BIC$fits[[1]], xlim=c(-3,3), ylim=c(1,4), legend = "bottomright")

8-7. 追加分析の3時点目：強い素因ストレスモデル

GxE_test_BIC = GxE_interaction_test(data=df, genes=df[,"hsc_T2", drop=FALSE], env=df[,"ev_T2", drop = FALSE], formula_noGxE = wb_T3 ~ 1, crossover = c("min","max"), criterion="BIC")
GxE_test_BIC
## $fits
## $fits$diathesis_stress_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##     3.23991      0.02864  
## 
## Degrees of Freedom: 86 Total (i.e. Null);  85 Residual
## Null Deviance:       69.83 
## Residual Deviance: 63.71     AIC: 225.8
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_T2  
##      1  
## 
## Degrees of Freedom: 87 Total (i.e. Null);  86 Residual
## Null Deviance:       79.95 
## Residual Deviance: 63.71     AIC: 223.8
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T2  
##     1  
## 
## Degrees of Freedom: 87 Total (i.e. Null);  86 Residual
## Null Deviance:       70.35 
## Residual Deviance: 63.71     AIC: 223.8
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 225.7934
## 
## $true_model_parameters$AICc
## [1] 226.0826
## 
## $true_model_parameters$BIC
## [1] 233.1911
## 
## $true_model_parameters$rank
## [1] 2
## 
## $true_model_parameters$df.residual
## [1] 85
## 
## $true_model_parameters$null.deviance
## [1] 69.82989
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T3 ~ 1 + G * E - G - E
## <environment: 0x000000001bde5a28>
## 
## $crossover
## [1] 3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$vantage_sensitivity_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##     2.40765      0.02597  
## 
## Degrees of Freedom: 86 Total (i.e. Null);  85 Residual
## Null Deviance:       69.83 
## Residual Deviance: 64.92     AIC: 227.4
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_T2  
##      1  
## 
## Degrees of Freedom: 87 Total (i.e. Null);  86 Residual
## Null Deviance:       90.82 
## Residual Deviance: 64.92     AIC: 225.4
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T2  
##     1  
## 
## Degrees of Freedom: 87 Total (i.e. Null);  86 Residual
## Null Deviance:       71.48 
## Residual Deviance: 64.86     AIC: 225.3
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 227.4324
## 
## $true_model_parameters$AICc
## [1] 227.7216
## 
## $true_model_parameters$BIC
## [1] 234.8302
## 
## $true_model_parameters$rank
## [1] 2
## 
## $true_model_parameters$df.residual
## [1] 85
## 
## $true_model_parameters$null.deviance
## [1] 69.82989
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T3 ~ 1 + G * E - G - E
## <environment: 0x000000001a951530>
## 
## $crossover
## [1] -3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$diathesis_stress_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##     3.21285     -0.13246      0.05193  
## 
## Degrees of Freedom: 86 Total (i.e. Null);  84 Residual
## Null Deviance:       69.83 
## Residual Deviance: 63.5  AIC: 227.5
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_T2  
##      1  
## 
## Degrees of Freedom: 87 Total (i.e. Null);  86 Residual
## Null Deviance:       116.9 
## Residual Deviance: 63.5  AIC: 223.5
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T2  
##     1  
## 
## Degrees of Freedom: 87 Total (i.e. Null);  86 Residual
## Null Deviance:       70.38 
## Residual Deviance: 63.47     AIC: 223.5
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 227.5046
## 
## $true_model_parameters$AICc
## [1] 227.9924
## 
## $true_model_parameters$BIC
## [1] 237.3682
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 84
## 
## $true_model_parameters$null.deviance
## [1] 69.82989
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T3 ~ 1 + G * E - G
## <environment: 0x000000001b38a2e8>
## 
## $crossover
## [1] 3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$diff_suscept_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##     3.19621      0.02883  
## 
## Degrees of Freedom: 86 Total (i.e. Null);  85 Residual
## Null Deviance:       69.83 
## Residual Deviance: 63.71     AIC: 225.8
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_T2  
##      1  
## 
## Degrees of Freedom: 87 Total (i.e. Null);  86 Residual
## Null Deviance:       77.52 
## Residual Deviance: 63.71     AIC: 223.8
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## crossover      ev_T2  
##      2.69       1.00  
## 
## Degrees of Freedom: 87 Total (i.e. Null);  85 Residual
## Null Deviance:       77.52 
## Residual Deviance: 63.71     AIC: 225.8
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 227.7886
## 
## $true_model_parameters$AICc
## [1] 228.2764
## 
## $true_model_parameters$BIC
## [1] 237.6522
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 84
## 
## $true_model_parameters$null.deviance
## [1] 69.82989
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T3 ~ 1 + G * E - G - E
## <environment: 0x0000000013ac98b0>
## 
## $crossover
## [1] 2.689635
## 
## $crossover_fixed
## [1] FALSE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$model_E_only
## 
## Call:  glm(formula = formula_model_E_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
## (Intercept)        ev_T2  
##      2.8110       0.1448  
## 
## Degrees of Freedom: 87 Total (i.e. Null);  86 Residual
##   (26 observations deleted due to missingness)
## Null Deviance:       71.03 
## Residual Deviance: 65.93     AIC: 230.3
## 
## $fits$model_GandE_only
## 
## Call:  glm(formula = formula_model_GandE_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
## (Intercept)       hsc_T2        ev_T2  
##     3.10480     -0.06002      0.14602  
## 
## Degrees of Freedom: 86 Total (i.e. Null);  84 Residual
##   (27 observations deleted due to missingness)
## Null Deviance:       69.83 
## Residual Deviance: 64.33     AIC: 228.6
## 
## $fits$vantage_sensitivity_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##    2.351255     0.132347     0.003054  
## 
## Degrees of Freedom: 86 Total (i.e. Null);  84 Residual
## Null Deviance:       69.83 
## Residual Deviance: 64.49     AIC: 228.9
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_T2  
##      1  
## 
## Degrees of Freedom: 87 Total (i.e. Null);  86 Residual
## Null Deviance:       64.85 
## Residual Deviance: 64.49     AIC: 224.9
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T2  
##     1  
## 
## Degrees of Freedom: 87 Total (i.e. Null);  86 Residual
## Null Deviance:       70.84 
## Residual Deviance: 64.49     AIC: 224.9
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 228.8512
## 
## $true_model_parameters$AICc
## [1] 229.339
## 
## $true_model_parameters$BIC
## [1] 238.7148
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 84
## 
## $true_model_parameters$null.deviance
## [1] 69.82989
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T3 ~ 1 + G * E - G
## <environment: 0x000000001246b4d8>
## 
## $crossover
## [1] -3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$diff_suscept_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##      2.9707      -0.4573       0.1134  
## 
## Degrees of Freedom: 86 Total (i.e. Null);  84 Residual
## Null Deviance:       69.83 
## Residual Deviance: 62.9  AIC: 226.7
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_T2  
##      1  
## 
## Degrees of Freedom: 87 Total (i.e. Null);  86 Residual
## Null Deviance:       160.9 
## Residual Deviance: 62.9  AIC: 222.7
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## crossover      ev_T2  
##     1.184      1.000  
## 
## Degrees of Freedom: 87 Total (i.e. Null);  85 Residual
## Null Deviance:       70.28 
## Residual Deviance: 62.9  AIC: 224.7
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 228.6799
## 
## $true_model_parameters$AICc
## [1] 229.4206
## 
## $true_model_parameters$BIC
## [1] 241.0094
## 
## $true_model_parameters$rank
## [1] 4
## 
## $true_model_parameters$df.residual
## [1] 83
## 
## $true_model_parameters$null.deviance
## [1] 69.82989
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T3 ~ 1 + G * E - G
## <environment: 0x0000000018d8bfb0>
## 
## $crossover
## [1] 1.183544
## 
## $crossover_fixed
## [1] FALSE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$model_G_only
## 
## Call:  glm(formula = formula_model_G_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
## (Intercept)       hsc_T2  
##     3.37864     -0.08902  
## 
## Degrees of Freedom: 90 Total (i.e. Null);  89 Residual
##   (23 observations deleted due to missingness)
## Null Deviance:       72.94 
## Residual Deviance: 72.55     AIC: 243.6
## 
## $fits$model_intercept_only
## 
## Call:  glm(formula = formula_model_intercept_only, family = family, 
##     data = cbind(data, genes, env))
## 
## Coefficients:
## (Intercept)  
##       2.899  
## 
## Degrees of Freedom: 104 Total (i.e. Null);  104 Residual
##   (9 observations deleted due to missingness)
## Null Deviance:       91.69 
## Residual Deviance: 91.69     AIC: 287.7
## 
## 
## $results
##                                    BIC      crossover crossover 95%     
## Diathesis-stress STRONG            "233.19" "3"       ""                
## Vantage sensitivity STRONG         "234.83" "-3"      ""                
## Diathesis-stress WEAK              "237.37" "3"       ""                
## Differential susceptibility STRONG "237.65" "2.69"    "( 1.39 / 3.99 )" 
## E only                             "237.76" NA        ""                
## G + E only                         "238.5"  NA        ""                
## Vantage sensitivity WEAK           "238.71" "-3"      ""                
## Differential susceptibility WEAK   "241.01" "1.18"    "( -0.07 / 2.44 )"
## G only                             "251.16" NA        ""                
## Intercept only                     "293.05" NA        ""                
##                                    Within observable range?
## Diathesis-stress STRONG            ""                      
## Vantage sensitivity STRONG         ""                      
## Diathesis-stress WEAK              ""                      
## Differential susceptibility STRONG "No"                    
## E only                             ""                      
## G + E only                         ""                      
## Vantage sensitivity WEAK           ""                      
## Differential susceptibility WEAK   "Yes"                   
## G only                             ""                      
## Intercept only                     ""                      
##                                    % of observations below crossover
## Diathesis-stress STRONG            "0.873563218390805"              
## Vantage sensitivity STRONG         "0.0344827586206897"             
## Diathesis-stress WEAK              "0.873563218390805"              
## Differential susceptibility STRONG "0.873563218390805"              
## E only                             NA                               
## G + E only                         NA                               
## Vantage sensitivity WEAK           "0"                              
## Differential susceptibility WEAK   "0.632183908045977"              
## G only                             NA                               
## Intercept only                     NA                               
## 
## $E_range
## [1] -3  3
# fits[[1]] is the best model (based on BIC)
summary(GxE_test_BIC$fits[[1]]) 
## $fit_main
## 
## Call:
## stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -2.2843  -0.5543  -0.0910   0.5507   2.2584  
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  3.23991    0.15123  21.424  < 2e-16 ***
## G:E          0.02864    0.01002   2.857  0.00538 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.7495673)
## 
##     Null deviance: 69.830  on 86  degrees of freedom
## Residual deviance: 63.713  on 85  degrees of freedom
## AIC: 225.79
## 
## Number of Fisher Scoring iterations: 2
## 
## 
## $fit_genes
## 
## Call:
## stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -2.2843  -0.5543  -0.0910   0.5507   2.2584  
## 
## Coefficients: (-1 not defined because of singularities)
##        Estimate Std. Error t value Pr(>|t|)    
## hsc_T2   1.0000     0.2149   4.654 1.19e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.7495673)
## 
##     Null deviance: 69.830  on 87  degrees of freedom
## Residual deviance: 63.713  on 85  degrees of freedom
## AIC: 225.79
## 
## Number of Fisher Scoring iterations: 2
## 
## 
## $fit_env
## 
## Call:
## stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -2.28592  -0.55535  -0.09254   0.55052   2.25837  
## 
## Coefficients: (-1 not defined because of singularities)
##       Estimate Std. Error t value Pr(>|t|)   
## ev_T2   1.0000     0.3362   2.975  0.00382 **
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.7495653)
## 
##     Null deviance: 69.830  on 87  degrees of freedom
## Residual deviance: 63.713  on 85  degrees of freedom
## AIC: 225.79
## 
## Number of Fisher Scoring iterations: 2
plot(GxE_test_BIC$fits[[1]], xlim=c(-3,3), ylim=c(1,4), legend = "bottomright")

8-8. 追加分析の4時点目：強い素因ストレスモデル```{r t1v, include=TRUE}

GxE_test_BIC = GxE_interaction_test(data=df, genes=df[,"hsc_T3", drop=FALSE], env=df[,"ev_T3", drop = FALSE], formula_noGxE = wb_T4 ~ 1, crossover = c("min","max"), criterion="BIC")
GxE_test_BIC
## $fits
## $fits$diathesis_stress_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##     3.31054      0.03548  
## 
## Degrees of Freedom: 96 Total (i.e. Null);  95 Residual
## Null Deviance:       112.8 
## Residual Deviance: 102.2     AIC: 286.3
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_T3  
##      1  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  96 Residual
## Null Deviance:       131.9 
## Residual Deviance: 102.2     AIC: 284.3
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T3  
##     1  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  96 Residual
## Null Deviance:       112.9 
## Residual Deviance: 102.2     AIC: 284.3
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 286.3151
## 
## $true_model_parameters$AICc
## [1] 286.5732
## 
## $true_model_parameters$BIC
## [1] 294.0392
## 
## $true_model_parameters$rank
## [1] 2
## 
## $true_model_parameters$df.residual
## [1] 95
## 
## $true_model_parameters$null.deviance
## [1] 112.7777
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T4 ~ 1 + G * E - G - E
## <environment: 0x000000001bd78498>
## 
## $crossover
## [1] 3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$vantage_sensitivity_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##      2.2241       0.0337  
## 
## Degrees of Freedom: 96 Total (i.e. Null);  95 Residual
## Null Deviance:       112.8 
## Residual Deviance: 104.4     AIC: 288.4
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_T3  
##      1  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  96 Residual
## Null Deviance:       152.7 
## Residual Deviance: 104.4     AIC: 286.4
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T3  
##     1  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  96 Residual
## Null Deviance:       116.2 
## Residual Deviance: 104.3     AIC: 286.3
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 288.416
## 
## $true_model_parameters$AICc
## [1] 288.6741
## 
## $true_model_parameters$BIC
## [1] 296.1402
## 
## $true_model_parameters$rank
## [1] 2
## 
## $true_model_parameters$df.residual
## [1] 95
## 
## $true_model_parameters$null.deviance
## [1] 112.7777
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T4 ~ 1 + G * E - G - E
## <environment: 0x000000001a8a0ab8>
## 
## $crossover
## [1] -3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$model_E_only
## 
## Call:  glm(formula = formula_model_E_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
## (Intercept)        ev_T3  
##      2.7414       0.1942  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  96 Residual
##   (16 observations deleted due to missingness)
## Null Deviance:       112.8 
## Residual Deviance: 103   AIC: 289
## 
## $fits$diff_suscept_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##     3.26609      0.03575  
## 
## Degrees of Freedom: 96 Total (i.e. Null);  95 Residual
## Null Deviance:       112.8 
## Residual Deviance: 102.2     AIC: 286.3
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_T3  
##      1  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  96 Residual
## Null Deviance:       128.3 
## Residual Deviance: 102.2     AIC: 284.3
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## crossover      ev_T3  
##     2.746      1.000  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  95 Residual
## Null Deviance:       128.3 
## Residual Deviance: 102.2     AIC: 286.3
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 288.3115
## 
## $true_model_parameters$AICc
## [1] 288.7462
## 
## $true_model_parameters$BIC
## [1] 298.6103
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 94
## 
## $true_model_parameters$null.deviance
## [1] 112.7777
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T4 ~ 1 + G * E - G - E
## <environment: 0x0000000013a4cce8>
## 
## $crossover
## [1] 2.745783
## 
## $crossover_fixed
## [1] FALSE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$diathesis_stress_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##    3.308476    -0.008593     0.036915  
## 
## Degrees of Freedom: 96 Total (i.e. Null);  94 Residual
## Null Deviance:       112.8 
## Residual Deviance: 102.2     AIC: 288.3
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_T3  
##      1  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  96 Residual
## Null Deviance:       134.4 
## Residual Deviance: 102.2     AIC: 284.3
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T3  
##     1  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  96 Residual
## Null Deviance:       112.8 
## Residual Deviance: 102.2     AIC: 284.3
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 288.3142
## 
## $true_model_parameters$AICc
## [1] 288.749
## 
## $true_model_parameters$BIC
## [1] 298.613
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 94
## 
## $true_model_parameters$null.deviance
## [1] 112.7777
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T4 ~ 1 + G * E - G
## <environment: 0x000000001b226718>
## 
## $crossover
## [1] 3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$model_GandE_only
## 
## Call:  glm(formula = formula_model_GandE_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
## (Intercept)       hsc_T3        ev_T3  
##     3.11838     -0.07245      0.19387  
## 
## Degrees of Freedom: 96 Total (i.e. Null);  94 Residual
##   (17 observations deleted due to missingness)
## Null Deviance:       112.8 
## Residual Deviance: 102.5     AIC: 288.6
## 
## $fits$vantage_sensitivity_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##    2.132789     0.235887    -0.006894  
## 
## Degrees of Freedom: 96 Total (i.e. Null);  94 Residual
## Null Deviance:       112.8 
## Residual Deviance: 102.7     AIC: 288.8
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_T3  
##      1  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  96 Residual
## Null Deviance:       104.8 
## Residual Deviance: 102.7     AIC: 284.8
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T3  
##     1  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  96 Residual
## Null Deviance:       114.2 
## Residual Deviance: 102.7     AIC: 284.8
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 288.8429
## 
## $true_model_parameters$AICc
## [1] 289.2777
## 
## $true_model_parameters$BIC
## [1] 299.1417
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 94
## 
## $true_model_parameters$null.deviance
## [1] 112.7777
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T4 ~ 1 + G * E - G
## <environment: 0x00000000125b9388>
## 
## $crossover
## [1] -3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$diff_suscept_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##     3.19172     -0.04837      0.04440  
## 
## Degrees of Freedom: 96 Total (i.e. Null);  94 Residual
## Null Deviance:       112.8 
## Residual Deviance: 102.2     AIC: 288.3
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## hsc_T3  
##      1  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  96 Residual
## Null Deviance:       134.3 
## Residual Deviance: 102.2     AIC: 284.3
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## crossover      ev_T3  
##     2.365      1.000  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  95 Residual
## Null Deviance:       123.1 
## Residual Deviance: 102.2     AIC: 286.3
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 290.2987
## 
## $true_model_parameters$AICc
## [1] 290.958
## 
## $true_model_parameters$BIC
## [1] 303.1722
## 
## $true_model_parameters$rank
## [1] 4
## 
## $true_model_parameters$df.residual
## [1] 93
## 
## $true_model_parameters$null.deviance
## [1] 112.7777
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T4 ~ 1 + G * E - G
## <environment: 0x0000000018db3450>
## 
## $crossover
## [1] 2.365059
## 
## $crossover_fixed
## [1] FALSE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$model_G_only
## 
## Call:  glm(formula = formula_model_G_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
## (Intercept)       hsc_T3  
##      3.6182      -0.1427  
## 
## Degrees of Freedom: 98 Total (i.e. Null);  97 Residual
##   (15 observations deleted due to missingness)
## Null Deviance:       113.1 
## Residual Deviance: 112   AIC: 299.2
## 
## $fits$model_intercept_only
## 
## Call:  glm(formula = formula_model_intercept_only, family = family, 
##     data = cbind(data, genes, env))
## 
## Coefficients:
## (Intercept)  
##       2.864  
## 
## Degrees of Freedom: 105 Total (i.e. Null);  105 Residual
##   (8 observations deleted due to missingness)
## Null Deviance:       119.1 
## Residual Deviance: 119.1     AIC: 317.2
## 
## 
## $results
##                                    BIC      crossover crossover 95%    
## Diathesis-stress STRONG            "294.04" "3"       ""               
## Vantage sensitivity STRONG         "296.14" "-3"      ""               
## E only                             "296.73" NA        ""               
## Differential susceptibility STRONG "298.61" "2.75"    "( 1.6 / 3.9 )"  
## Diathesis-stress WEAK              "298.61" "3"       ""               
## G + E only                         "298.93" NA        ""               
## Vantage sensitivity WEAK           "299.14" "-3"      ""               
## Differential susceptibility WEAK   "303.17" "2.37"    "( 1.21 / 3.52 )"
## G only                             "306.95" NA        ""               
## Intercept only                     "322.48" NA        ""               
##                                    Within observable range?
## Diathesis-stress STRONG            ""                      
## Vantage sensitivity STRONG         ""                      
## E only                             ""                      
## Differential susceptibility STRONG "No"                    
## Diathesis-stress WEAK              ""                      
## G + E only                         ""                      
## Vantage sensitivity WEAK           ""                      
## Differential susceptibility WEAK   "No"                    
## G only                             ""                      
## Intercept only                     ""                      
##                                    % of observations below crossover
## Diathesis-stress STRONG            "1"                              
## Vantage sensitivity STRONG         "0"                              
## E only                             NA                               
## Differential susceptibility STRONG "0.855670103092783"              
## Diathesis-stress WEAK              "0.855670103092783"              
## G + E only                         NA                               
## Vantage sensitivity WEAK           "0.0618556701030928"             
## Differential susceptibility WEAK   "0.804123711340206"              
## G only                             NA                               
## Intercept only                     NA                               
## 
## $E_range
## [1] -3  3
# fits[[1]] is the best model (based on BIC)
summary(GxE_test_BIC$fits[[1]]) 
## $fit_main
## 
## Call:
## stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -2.5105  -0.7105  -0.1600   0.7477   2.1876  
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  3.31054    0.17645   18.76  < 2e-16 ***
## G:E          0.03548    0.01130    3.14  0.00225 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 1.075519)
## 
##     Null deviance: 112.78  on 96  degrees of freedom
## Residual deviance: 102.17  on 95  degrees of freedom
## AIC: 286.32
## 
## Number of Fisher Scoring iterations: 2
## 
## 
## $fit_genes
## 
## Call:
## stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -2.5105  -0.7105  -0.1600   0.7477   2.1876  
## 
## Coefficients: (-1 not defined because of singularities)
##        Estimate Std. Error t value Pr(>|t|)    
## hsc_T3   1.0000     0.1901   5.262 8.82e-07 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 1.075519)
## 
##     Null deviance: 112.78  on 97  degrees of freedom
## Residual deviance: 102.17  on 95  degrees of freedom
## AIC: 286.32
## 
## Number of Fisher Scoring iterations: 2
## 
## 
## $fit_env
## 
## Call:
## stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -2.5131  -0.7130  -0.1597   0.7473   2.1872  
## 
## Coefficients: (-1 not defined because of singularities)
##       Estimate Std. Error t value Pr(>|t|)   
## ev_T3   1.0000     0.3168   3.156  0.00214 **
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 1.075517)
## 
##     Null deviance: 112.78  on 97  degrees of freedom
## Residual deviance: 102.17  on 95  degrees of freedom
## AIC: 286.32
## 
## Number of Fisher Scoring iterations: 2
plot(GxE_test_BIC$fits[[1]], xlim=c(-3,3), ylim=c(1,4), legend = "bottomright")

(9) VSを示唆するAESを用いた再分析

9-1. 1時点目のモデル：VS支持

GxE_test_BIC = GxE_interaction_test(data=df, genes=df[,"aes_T1", drop=FALSE], env=df[,"ev_T1", drop = FALSE], formula_noGxE = wb_T1 ~ 1, crossover = c("min","max"), criterion="BIC")
GxE_test_BIC
## $fits
## $fits$vantage_sensitivity_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##     2.05034      0.03127  
## 
## Degrees of Freedom: 110 Total (i.e. Null);  109 Residual
## Null Deviance:       78.03 
## Residual Deviance: 68.01     AIC: 266.6
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## aes_T1  
##      1  
## 
## Degrees of Freedom: 111 Total (i.e. Null);  110 Residual
## Null Deviance:       129.8 
## Residual Deviance: 68.01     AIC: 264.6
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T1  
##     1  
## 
## Degrees of Freedom: 111 Total (i.e. Null);  110 Residual
## Null Deviance:       79.07 
## Residual Deviance: 68.01     AIC: 264.6
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 266.6308
## 
## $true_model_parameters$AICc
## [1] 266.8551
## 
## $true_model_parameters$BIC
## [1] 274.7594
## 
## $true_model_parameters$rank
## [1] 2
## 
## $true_model_parameters$df.residual
## [1] 109
## 
## $true_model_parameters$null.deviance
## [1] 78.02667
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T1 ~ 1 + G * E - G - E
## <environment: 0x000000001a9bec48>
## 
## $crossover
## [1] -3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$model_E_only
## 
## Call:  glm(formula = formula_model_E_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
## (Intercept)        ev_T1  
##      2.5927       0.1765  
## 
## Degrees of Freedom: 111 Total (i.e. Null);  110 Residual
##   (2 observations deleted due to missingness)
## Null Deviance:       78.04 
## Residual Deviance: 69.24     AIC: 270
## 
## $fits$diathesis_stress_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##     3.08856      0.02803  
## 
## Degrees of Freedom: 110 Total (i.e. Null);  109 Residual
## Null Deviance:       78.03 
## Residual Deviance: 70.52     AIC: 270.7
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## aes_T1  
##      1  
## 
## Degrees of Freedom: 111 Total (i.e. Null);  110 Residual
## Null Deviance:       92.03 
## Residual Deviance: 70.52     AIC: 268.7
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T1  
##     1  
## 
## Degrees of Freedom: 111 Total (i.e. Null);  110 Residual
## Null Deviance:       81.66 
## Residual Deviance: 70.43     AIC: 268.5
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 270.6548
## 
## $true_model_parameters$AICc
## [1] 270.8791
## 
## $true_model_parameters$BIC
## [1] 278.7834
## 
## $true_model_parameters$rank
## [1] 2
## 
## $true_model_parameters$df.residual
## [1] 109
## 
## $true_model_parameters$null.deviance
## [1] 78.02667
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T1 ~ 1 + G * E - G - E
## <environment: 0x000000001bf5dca0>
## 
## $crossover
## [1] 3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$model_GandE_only
## 
## Call:  glm(formula = formula_model_GandE_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
## (Intercept)       aes_T1        ev_T1  
##      1.5527       0.1812       0.1746  
## 
## Degrees of Freedom: 110 Total (i.e. Null);  108 Residual
##   (3 observations deleted due to missingness)
## Null Deviance:       78.03 
## Residual Deviance: 67.73     AIC: 268.2
## 
## $fits$diff_suscept_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##     1.71067      0.03006  
## 
## Degrees of Freedom: 110 Total (i.e. Null);  109 Residual
## Null Deviance:       78.03 
## Residual Deviance: 67.84     AIC: 266.4
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## aes_T1  
##      1  
## 
## Degrees of Freedom: 111 Total (i.e. Null);  110 Residual
## Null Deviance:       194.1 
## Residual Deviance: 67.84     AIC: 264.4
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## crossover      ev_T1  
##    -5.118      1.000  
## 
## Degrees of Freedom: 111 Total (i.e. Null);  109 Residual
## Null Deviance:       194.1 
## Residual Deviance: 67.84     AIC: 266.4
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 268.3529
## 
## $true_model_parameters$AICc
## [1] 268.7303
## 
## $true_model_parameters$BIC
## [1] 279.1911
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 108
## 
## $true_model_parameters$null.deviance
## [1] 78.02667
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T1 ~ 1 + G * E - G - E
## <environment: 0x000000001a4b5e68>
## 
## $crossover
## [1] -5.11752
## 
## $crossover_fixed
## [1] FALSE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$vantage_sensitivity_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##     2.06742     -0.05534      0.04010  
## 
## Degrees of Freedom: 110 Total (i.e. Null);  108 Residual
## Null Deviance:       78.03 
## Residual Deviance: 67.94     AIC: 268.5
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## aes_T1  
##      1  
## 
## Degrees of Freedom: 111 Total (i.e. Null);  110 Residual
## Null Deviance:       169.6 
## Residual Deviance: 67.94     AIC: 264.5
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T1  
##     1  
## 
## Degrees of Freedom: 111 Total (i.e. Null);  110 Residual
## Null Deviance:       78.75 
## Residual Deviance: 67.94     AIC: 264.5
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 268.5203
## 
## $true_model_parameters$AICc
## [1] 268.8976
## 
## $true_model_parameters$BIC
## [1] 279.3584
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 108
## 
## $true_model_parameters$null.deviance
## [1] 78.02667
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T1 ~ 1 + G * E - G
## <environment: 0x000000001240ce08>
## 
## $crossover
## [1] -3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$diathesis_stress_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##     3.11986      0.51054     -0.05843  
## 
## Degrees of Freedom: 110 Total (i.e. Null);  108 Residual
## Null Deviance:       78.03 
## Residual Deviance: 68.21     AIC: 269
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## aes_T1  
##      1  
## 
## Degrees of Freedom: 111 Total (i.e. Null);  110 Residual
## Null Deviance:       161.6 
## Residual Deviance: 68.21     AIC: 265
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T1  
##     1  
## 
## Degrees of Freedom: 111 Total (i.e. Null);  110 Residual
## Null Deviance:       78.44 
## Residual Deviance: 68.19     AIC: 264.9
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 268.9504
## 
## $true_model_parameters$AICc
## [1] 269.3278
## 
## $true_model_parameters$BIC
## [1] 279.7885
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 108
## 
## $true_model_parameters$null.deviance
## [1] 78.02667
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T1 ~ 1 + G * E - G
## <environment: 0x000000001b5c93d0>
## 
## $crossover
## [1] 3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$diff_suscept_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##   14.671016     0.189811    -0.002654  
## 
## Degrees of Freedom: 110 Total (i.e. Null);  108 Residual
## Null Deviance:       78.03 
## Residual Deviance: 67.73     AIC: 268.2
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## aes_T1  
##      1  
## 
## Degrees of Freedom: 111 Total (i.e. Null);  110 Residual
## Null Deviance:       190.3 
## Residual Deviance: 67.73     AIC: 264.2
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## crossover      ev_T1  
##     69.19       1.00  
## 
## Degrees of Freedom: 111 Total (i.e. Null);  109 Residual
## Null Deviance:       15900 
## Residual Deviance: 67.73     AIC: 266.2
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 270.1735
## 
## $true_model_parameters$AICc
## [1] 270.745
## 
## $true_model_parameters$BIC
## [1] 283.7212
## 
## $true_model_parameters$rank
## [1] 4
## 
## $true_model_parameters$df.residual
## [1] 107
## 
## $true_model_parameters$null.deviance
## [1] 78.02667
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T1 ~ 1 + G * E - G
## <environment: 0x000000001867be00>
## 
## $crossover
## [1] 69.18552
## 
## $crossover_fixed
## [1] FALSE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$model_intercept_only
## 
## Call:  glm(formula = formula_model_intercept_only, family = family, 
##     data = cbind(data, genes, env))
## 
## Coefficients:
## (Intercept)  
##       2.735  
## 
## Degrees of Freedom: 112 Total (i.e. Null);  112 Residual
##   (1 observation deleted due to missingness)
## Null Deviance:       78.12 
## Residual Deviance: 78.12     AIC: 283
## 
## $fits$model_G_only
## 
## Call:  glm(formula = formula_model_G_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
## (Intercept)       aes_T1  
##      1.6193       0.1939  
## 
## Degrees of Freedom: 111 Total (i.e. Null);  110 Residual
##   (2 observations deleted due to missingness)
## Null Deviance:       78.1 
## Residual Deviance: 76.36     AIC: 280.9
## 
## 
## $results
##                                    BIC      crossover crossover 95%      
## Vantage sensitivity STRONG         "274.76" "-3"      ""                 
## E only                             "278.13" NA        ""                 
## Diathesis-stress STRONG            "278.78" "3"       ""                 
## G + E only                         "279.01" NA        ""                 
## Differential susceptibility STRONG "279.19" "-5.12"   "( -6.06 / -4.17 )"
## Vantage sensitivity WEAK           "279.36" "-3"      ""                 
## Diathesis-stress WEAK              "279.79" "3"       ""                 
## Differential susceptibility WEAK   "283.72" "69.19"   "( 68.25 / 70.12 )"
## Intercept only                     "288.42" NA        ""                 
## G only                             "289.1"  NA        ""                 
##                                    Within observable range?
## Vantage sensitivity STRONG         ""                      
## E only                             ""                      
## Diathesis-stress STRONG            ""                      
## G + E only                         ""                      
## Differential susceptibility STRONG "No"                    
## Vantage sensitivity WEAK           ""                      
## Diathesis-stress WEAK              ""                      
## Differential susceptibility WEAK   "No"                    
## Intercept only                     ""                      
## G only                             ""                      
##                                    % of observations below crossover
## Vantage sensitivity STRONG         "0"                              
## E only                             NA                               
## Diathesis-stress STRONG            "1"                              
## G + E only                         NA                               
## Differential susceptibility STRONG "0"                              
## Vantage sensitivity WEAK           "0"                              
## Diathesis-stress WEAK              "0.828828828828829"              
## Differential susceptibility WEAK   "1"                              
## Intercept only                     NA                               
## G only                             NA                               
## 
## $E_range
## [1] -3  3
# fits[[1]] is the best model (based on BIC)
summary(GxE_test_BIC$fits[[1]]) 
## $fit_main
## 
## Call:
## stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -1.81121  -0.51123  -0.03923   0.57671   1.70342  
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 2.050339   0.186237  11.009  < 2e-16 ***
## G:E         0.031269   0.007805   4.006 0.000113 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.6239599)
## 
##     Null deviance: 78.027  on 110  degrees of freedom
## Residual deviance: 68.012  on 109  degrees of freedom
## AIC: 266.63
## 
## Number of Fisher Scoring iterations: 2
## 
## 
## $fit_genes
## 
## Call:
## stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -1.81121  -0.51123  -0.03923   0.57671   1.70342  
## 
## Coefficients: (-1 not defined because of singularities)
##        Estimate Std. Error t value Pr(>|t|)    
## aes_T1   1.0000     0.1005   9.952   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.6239599)
## 
##     Null deviance: 78.027  on 111  degrees of freedom
## Residual deviance: 68.012  on 109  degrees of freedom
## AIC: 266.63
## 
## Number of Fisher Scoring iterations: 2
## 
## 
## $fit_env
## 
## Call:
## stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -1.79977  -0.51026  -0.02948   0.57476   1.69807  
## 
## Coefficients: (-1 not defined because of singularities)
##       Estimate Std. Error t value Pr(>|t|)    
## ev_T1   1.0000     0.2375    4.21 5.26e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.62391)
## 
##     Null deviance: 78.027  on 111  degrees of freedom
## Residual deviance: 68.006  on 109  degrees of freedom
## AIC: 266.63
## 
## Number of Fisher Scoring iterations: 2
plot(GxE_test_BIC$fits$vantage_sensitivity_STRONG, xlim=c(-3,3), ylim=c(1,4), legend = "bottomright")

9-2. 2時点目のモデル：VS支持

GxE_test_BIC = GxE_interaction_test(data=df, genes=df[,"aes_T2", drop=FALSE], env=df[,"ev_T2", drop = FALSE], formula_noGxE = wb_T2 ~ 1, crossover = c("min","max"), criterion="BIC")
GxE_test_BIC
## $fits
## $fits$vantage_sensitivity_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##     2.26352      0.03282  
## 
## Degrees of Freedom: 93 Total (i.e. Null);  92 Residual
## Null Deviance:       79.46 
## Residual Deviance: 69.64     AIC: 244.6
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## aes_T2  
##      1  
## 
## Degrees of Freedom: 94 Total (i.e. Null);  93 Residual
## Null Deviance:       126.1 
## Residual Deviance: 69.64     AIC: 242.6
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T2  
##     1  
## 
## Degrees of Freedom: 94 Total (i.e. Null);  93 Residual
## Null Deviance:       80.32 
## Residual Deviance: 69.63     AIC: 242.6
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 244.5602
## 
## $true_model_parameters$AICc
## [1] 244.8268
## 
## $true_model_parameters$BIC
## [1] 252.1901
## 
## $true_model_parameters$rank
## [1] 2
## 
## $true_model_parameters$df.residual
## [1] 92
## 
## $true_model_parameters$null.deviance
## [1] 79.46426
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T2 ~ 1 + G * E - G - E
## <environment: 0x000000001ad1f188>
## 
## $crossover
## [1] -3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$model_E_only
## 
## Call:  glm(formula = formula_model_E_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
## (Intercept)        ev_T2  
##      2.8339       0.1752  
## 
## Degrees of Freedom: 93 Total (i.e. Null);  92 Residual
##   (20 observations deleted due to missingness)
## Null Deviance:       79.46 
## Residual Deviance: 71.7  AIC: 247.3
## 
## $fits$diathesis_stress_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##     3.33529      0.02899  
## 
## Degrees of Freedom: 93 Total (i.e. Null);  92 Residual
## Null Deviance:       79.46 
## Residual Deviance: 72.19     AIC: 247.9
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## aes_T2  
##      1  
## 
## Degrees of Freedom: 94 Total (i.e. Null);  93 Residual
## Null Deviance:       92.14 
## Residual Deviance: 72.19     AIC: 245.9
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T2  
##     1  
## 
## Degrees of Freedom: 94 Total (i.e. Null);  93 Residual
## Null Deviance:       82.77 
## Residual Deviance: 72.08     AIC: 245.8
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 247.9408
## 
## $true_model_parameters$AICc
## [1] 248.2075
## 
## $true_model_parameters$BIC
## [1] 255.5707
## 
## $true_model_parameters$rank
## [1] 2
## 
## $true_model_parameters$df.residual
## [1] 92
## 
## $true_model_parameters$null.deviance
## [1] 79.46426
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T2 ~ 1 + G * E - G - E
## <environment: 0x000000001c542d38>
## 
## $crossover
## [1] 3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$vantage_sensitivity_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##     2.32595     -0.18904      0.06308  
## 
## Degrees of Freedom: 93 Total (i.e. Null);  91 Residual
## Null Deviance:       79.46 
## Residual Deviance: 68.95     AIC: 245.6
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## aes_T2  
##      1  
## 
## Degrees of Freedom: 94 Total (i.e. Null);  93 Residual
## Null Deviance:       277.6 
## Residual Deviance: 68.95     AIC: 241.6
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T2  
##     1  
## 
## Degrees of Freedom: 94 Total (i.e. Null);  93 Residual
## Null Deviance:       79.85 
## Residual Deviance: 68.92     AIC: 241.6
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 245.6309
## 
## $true_model_parameters$AICc
## [1] 246.0803
## 
## $true_model_parameters$BIC
## [1] 255.804
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 91
## 
## $true_model_parameters$null.deviance
## [1] 79.46426
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T2 ~ 1 + G * E - G
## <environment: 0x00000000138af740>
## 
## $crossover
## [1] -3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$diff_suscept_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##     2.04579      0.03197  
## 
## Degrees of Freedom: 93 Total (i.e. Null);  92 Residual
## Null Deviance:       79.46 
## Residual Deviance: 69.56     AIC: 244.5
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## aes_T2  
##      1  
## 
## Degrees of Freedom: 94 Total (i.e. Null);  93 Residual
## Null Deviance:       159.4 
## Residual Deviance: 69.56     AIC: 242.5
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## crossover      ev_T2  
##    -4.298      1.000  
## 
## Degrees of Freedom: 94 Total (i.e. Null);  92 Residual
## Null Deviance:       159.4 
## Residual Deviance: 69.56     AIC: 244.5
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 246.4536
## 
## $true_model_parameters$AICc
## [1] 246.903
## 
## $true_model_parameters$BIC
## [1] 256.6267
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 91
## 
## $true_model_parameters$null.deviance
## [1] 79.46426
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T2 ~ 1 + G * E - G - E
## <environment: 0x000000001a927ed0>
## 
## $crossover
## [1] -4.298077
## 
## $crossover_fixed
## [1] FALSE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$model_GandE_only
## 
## Call:  glm(formula = formula_model_GandE_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
## (Intercept)       aes_T2        ev_T2  
##      1.9923       0.1483       0.1728  
## 
## Degrees of Freedom: 93 Total (i.e. Null);  91 Residual
##   (20 observations deleted due to missingness)
## Null Deviance:       79.46 
## Residual Deviance: 70.61     AIC: 247.9
## 
## $fits$diff_suscept_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##      2.6962      -0.5791       0.1314  
## 
## Degrees of Freedom: 93 Total (i.e. Null);  91 Residual
## Null Deviance:       79.46 
## Residual Deviance: 68.08     AIC: 244.4
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## aes_T2  
##      1  
## 
## Degrees of Freedom: 94 Total (i.e. Null);  93 Residual
## Null Deviance:       348 
## Residual Deviance: 68.08     AIC: 240.4
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## crossover      ev_T2  
##   -0.8138     1.0000  
## 
## Degrees of Freedom: 94 Total (i.e. Null);  92 Residual
## Null Deviance:       86.41 
## Residual Deviance: 68.08     AIC: 242.4
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 246.4413
## 
## $true_model_parameters$AICc
## [1] 247.1231
## 
## $true_model_parameters$BIC
## [1] 259.1577
## 
## $true_model_parameters$rank
## [1] 4
## 
## $true_model_parameters$df.residual
## [1] 90
## 
## $true_model_parameters$null.deviance
## [1] 79.46426
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T2 ~ 1 + G * E - G
## <environment: 0x0000000017d41538>
## 
## $crossover
## [1] -0.8138428
## 
## $crossover_fixed
## [1] FALSE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$diathesis_stress_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##    3.359497     0.181217    -0.001061  
## 
## Degrees of Freedom: 93 Total (i.e. Null);  91 Residual
## Null Deviance:       79.46 
## Residual Deviance: 71.7  AIC: 249.3
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## aes_T2  
##      1  
## 
## Degrees of Freedom: 94 Total (i.e. Null);  93 Residual
## Null Deviance:       71.73 
## Residual Deviance: 71.7  AIC: 245.3
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T2  
##     1  
## 
## Degrees of Freedom: 94 Total (i.e. Null);  93 Residual
## Null Deviance:       81.1 
## Residual Deviance: 71.7  AIC: 245.3
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 249.3088
## 
## $true_model_parameters$AICc
## [1] 249.7582
## 
## $true_model_parameters$BIC
## [1] 259.482
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 91
## 
## $true_model_parameters$null.deviance
## [1] 79.46426
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T2 ~ 1 + G * E - G
## <environment: 0x000000001b9bb938>
## 
## $crossover
## [1] 3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$model_intercept_only
## 
## Call:  glm(formula = formula_model_intercept_only, family = family, 
##     data = cbind(data, genes, env))
## 
## Coefficients:
## (Intercept)  
##       2.972  
## 
## Degrees of Freedom: 98 Total (i.e. Null);  98 Residual
##   (15 observations deleted due to missingness)
## Null Deviance:       81.04 
## Residual Deviance: 81.04     AIC: 265.1
## 
## $fits$model_G_only
## 
## Call:  glm(formula = formula_model_G_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
## (Intercept)       aes_T2  
##      2.1330       0.1474  
## 
## Degrees of Freedom: 98 Total (i.e. Null);  97 Residual
##   (15 observations deleted due to missingness)
## Null Deviance:       81.04 
## Residual Deviance: 79.86     AIC: 265.7
## 
## 
## $results
##                                    BIC      crossover crossover 95%      
## Vantage sensitivity STRONG         "252.19" "-3"      ""                 
## E only                             "254.94" NA        ""                 
## Diathesis-stress STRONG            "255.57" "3"       ""                 
## Vantage sensitivity WEAK           "255.8"  "-3"      ""                 
## Differential susceptibility STRONG "256.63" "-4.3"    "( -5.36 / -3.24 )"
## G + E only                         "258.04" NA        ""                 
## Differential susceptibility WEAK   "259.16" "-0.81"   "( -1.79 / 0.16 )" 
## Diathesis-stress WEAK              "259.48" "3"       ""                 
## Intercept only                     "270.32" NA        ""                 
## G only                             "273.47" NA        ""                 
##                                    Within observable range?
## Vantage sensitivity STRONG         ""                      
## E only                             ""                      
## Diathesis-stress STRONG            ""                      
## Vantage sensitivity WEAK           ""                      
## Differential susceptibility STRONG "No"                    
## G + E only                         ""                      
## Differential susceptibility WEAK   "Yes"                   
## Diathesis-stress WEAK              ""                      
## Intercept only                     ""                      
## G only                             ""                      
##                                    % of observations below crossover
## Vantage sensitivity STRONG         "0"                              
## E only                             NA                               
## Diathesis-stress STRONG            "1"                              
## Vantage sensitivity WEAK           "0.0212765957446809"             
## Differential susceptibility STRONG "0"                              
## G + E only                         NA                               
## Differential susceptibility WEAK   "0.159574468085106"              
## Diathesis-stress WEAK              "0.851063829787234"              
## Intercept only                     NA                               
## G only                             NA                               
## 
## $E_range
## [1] -3  3
# fits[[1]] is the best model (based on BIC)
summary(GxE_test_BIC$fits[[1]]) 
## $fit_main
## 
## Call:
## stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -1.64816  -0.60584  -0.02406   0.55261   2.26878  
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 2.263517   0.215143  10.521  < 2e-16 ***
## G:E         0.032821   0.009109   3.603  0.00051 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.7569208)
## 
##     Null deviance: 79.464  on 93  degrees of freedom
## Residual deviance: 69.637  on 92  degrees of freedom
## AIC: 244.56
## 
## Number of Fisher Scoring iterations: 2
## 
## 
## $fit_genes
## 
## Call:
## stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -1.64816  -0.60584  -0.02406   0.55261   2.26878  
## 
## Coefficients: (-1 not defined because of singularities)
##        Estimate Std. Error t value Pr(>|t|)    
## aes_T2   1.0000     0.1158   8.639 1.66e-13 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.7569208)
## 
##     Null deviance: 79.464  on 94  degrees of freedom
## Residual deviance: 69.637  on 92  degrees of freedom
## AIC: 244.56
## 
## Number of Fisher Scoring iterations: 2
## 
## 
## $fit_env
## 
## Call:
## stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -1.64149  -0.60866  -0.01799   0.55855   2.26878  
## 
## Coefficients: (-1 not defined because of singularities)
##       Estimate Std. Error t value Pr(>|t|)    
## ev_T2   1.0000     0.2662   3.757 0.000301 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.7568863)
## 
##     Null deviance: 79.464  on 94  degrees of freedom
## Residual deviance: 69.634  on 92  degrees of freedom
## AIC: 244.56
## 
## Number of Fisher Scoring iterations: 2
plot(GxE_test_BIC$fits[[1]], xlim=c(-3,3), ylim=c(1,4), legend = "bottomright")

9-3. 3時点目のモデル：VS支持

GxE_test_BIC = GxE_interaction_test(data=df, genes=df[,"aes_T3", drop=FALSE], env=df[,"ev_T3", drop = FALSE], formula_noGxE = wb_T3 ~ 1, crossover = c("min","max"), criterion="BIC")
GxE_test_BIC
## $fits
## $fits$vantage_sensitivity_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##     2.15319      0.03401  
## 
## Degrees of Freedom: 102 Total (i.e. Null);  101 Residual
## Null Deviance:       90.86 
## Residual Deviance: 78.05     AIC: 269.7
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## aes_T3  
##      1  
## 
## Degrees of Freedom: 103 Total (i.e. Null);  102 Residual
## Null Deviance:       146.7 
## Residual Deviance: 78.05     AIC: 267.7
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T3  
##     1  
## 
## Degrees of Freedom: 103 Total (i.e. Null);  102 Residual
## Null Deviance:       91.24 
## Residual Deviance: 78.05     AIC: 267.7
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 269.7251
## 
## $true_model_parameters$AICc
## [1] 269.9676
## 
## $true_model_parameters$BIC
## [1] 277.6293
## 
## $true_model_parameters$rank
## [1] 2
## 
## $true_model_parameters$df.residual
## [1] 101
## 
## $true_model_parameters$null.deviance
## [1] 90.85825
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T3 ~ 1 + G * E - G - E
## <environment: 0x000000001b3882e8>
## 
## $crossover
## [1] -3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$model_E_only
## 
## Call:  glm(formula = formula_model_E_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
## (Intercept)        ev_T3  
##      2.7559       0.2036  
## 
## Degrees of Freedom: 102 Total (i.e. Null);  101 Residual
##   (11 observations deleted due to missingness)
## Null Deviance:       90.86 
## Residual Deviance: 79.67     AIC: 271.8
## 
## $fits$diathesis_stress_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##     3.35089      0.03405  
## 
## Degrees of Freedom: 102 Total (i.e. Null);  101 Residual
## Null Deviance:       90.86 
## Residual Deviance: 80.06     AIC: 272.4
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## aes_T3  
##      1  
## 
## Degrees of Freedom: 103 Total (i.e. Null);  102 Residual
## Null Deviance:       112.8 
## Residual Deviance: 80.06     AIC: 270.4
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T3  
##     1  
## 
## Degrees of Freedom: 103 Total (i.e. Null);  102 Residual
## Null Deviance:       95.3 
## Residual Deviance: 79.99     AIC: 270.3
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 272.3519
## 
## $true_model_parameters$AICc
## [1] 272.5943
## 
## $true_model_parameters$BIC
## [1] 280.2561
## 
## $true_model_parameters$rank
## [1] 2
## 
## $true_model_parameters$df.residual
## [1] 101
## 
## $true_model_parameters$null.deviance
## [1] 90.85825
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T3 ~ 1 + G * E - G - E
## <environment: 0x00000000186f6328>
## 
## $crossover
## [1] 3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$vantage_sensitivity_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##     2.19991     -0.12267      0.05257  
## 
## Degrees of Freedom: 102 Total (i.e. Null);  100 Residual
## Null Deviance:       90.86 
## Residual Deviance: 77.8  AIC: 271.4
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## aes_T3  
##      1  
## 
## Degrees of Freedom: 103 Total (i.e. Null);  102 Residual
## Null Deviance:       241.8 
## Residual Deviance: 77.8  AIC: 267.4
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T3  
##     1  
## 
## Degrees of Freedom: 103 Total (i.e. Null);  102 Residual
## Null Deviance:       90.62 
## Residual Deviance: 77.79     AIC: 267.4
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 271.397
## 
## $true_model_parameters$AICc
## [1] 271.8052
## 
## $true_model_parameters$BIC
## [1] 281.936
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 100
## 
## $true_model_parameters$null.deviance
## [1] 90.85825
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T3 ~ 1 + G * E - G
## <environment: 0x000000001a901210>
## 
## $crossover
## [1] -3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$diff_suscept_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##     2.08818      0.03371  
## 
## Degrees of Freedom: 102 Total (i.e. Null);  101 Residual
## Null Deviance:       90.86 
## Residual Deviance: 78.04     AIC: 269.7
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## aes_T3  
##      1  
## 
## Degrees of Freedom: 103 Total (i.e. Null);  102 Residual
## Null Deviance:       157 
## Residual Deviance: 78.04     AIC: 267.7
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## crossover      ev_T3  
##    -3.362      1.000  
## 
## Degrees of Freedom: 103 Total (i.e. Null);  101 Residual
## Null Deviance:       157 
## Residual Deviance: 78.04     AIC: 269.7
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 271.7178
## 
## $true_model_parameters$AICc
## [1] 272.126
## 
## $true_model_parameters$BIC
## [1] 282.2568
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 100
## 
## $true_model_parameters$null.deviance
## [1] 90.85825
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T3 ~ 1 + G * E - G - E
## <environment: 0x000000001af67af8>
## 
## $crossover
## [1] -3.362362
## 
## $crossover_fixed
## [1] FALSE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$model_GandE_only
## 
## Call:  glm(formula = formula_model_GandE_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
## (Intercept)       aes_T3        ev_T3  
##      1.9639       0.1361       0.1933  
## 
## Degrees of Freedom: 102 Total (i.e. Null);  100 Residual
##   (11 observations deleted due to missingness)
## Null Deviance:       90.86 
## Residual Deviance: 78.88     AIC: 272.8
## 
## $fits$diathesis_stress_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##    3.366822     0.189942     0.002372  
## 
## Degrees of Freedom: 102 Total (i.e. Null);  100 Residual
## Null Deviance:       90.86 
## Residual Deviance: 79.66     AIC: 273.8
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## aes_T3  
##      1  
## 
## Degrees of Freedom: 103 Total (i.e. Null);  102 Residual
## Null Deviance:       79.82 
## Residual Deviance: 79.66     AIC: 269.8
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T3  
##     1  
## 
## Degrees of Freedom: 103 Total (i.e. Null);  102 Residual
## Null Deviance:       92.85 
## Residual Deviance: 79.66     AIC: 269.8
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 273.8406
## 
## $true_model_parameters$AICc
## [1] 274.2488
## 
## $true_model_parameters$BIC
## [1] 284.3795
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 100
## 
## $true_model_parameters$null.deviance
## [1] 90.85825
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T3 ~ 1 + G * E - G
## <environment: 0x000000001beb3688>
## 
## $crossover
## [1] 3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$diff_suscept_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##      2.6304      -0.4780       0.1131  
## 
## Degrees of Freedom: 102 Total (i.e. Null);  100 Residual
## Null Deviance:       90.86 
## Residual Deviance: 77.2  AIC: 270.6
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## aes_T3  
##      1  
## 
## Degrees of Freedom: 103 Total (i.e. Null);  102 Residual
## Null Deviance:       282.8 
## Residual Deviance: 77.2  AIC: 266.6
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## crossover      ev_T3  
##   -0.6195     1.0000  
## 
## Degrees of Freedom: 103 Total (i.e. Null);  101 Residual
## Null Deviance:       97.76 
## Residual Deviance: 77.2  AIC: 268.6
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 272.603
## 
## $true_model_parameters$AICc
## [1] 273.2216
## 
## $true_model_parameters$BIC
## [1] 285.7767
## 
## $true_model_parameters$rank
## [1] 4
## 
## $true_model_parameters$df.residual
## [1] 99
## 
## $true_model_parameters$null.deviance
## [1] 90.85825
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T3 ~ 1 + G * E - G
## <environment: 0x0000000012ea9130>
## 
## $crossover
## [1] -0.6195284
## 
## $crossover_fixed
## [1] FALSE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$model_intercept_only
## 
## Call:  glm(formula = formula_model_intercept_only, family = family, 
##     data = cbind(data, genes, env))
## 
## Coefficients:
## (Intercept)  
##       2.899  
## 
## Degrees of Freedom: 104 Total (i.e. Null);  104 Residual
##   (9 observations deleted due to missingness)
## Null Deviance:       91.69 
## Residual Deviance: 91.69     AIC: 287.7
## 
## $fits$model_G_only
## 
## Call:  glm(formula = formula_model_G_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
## (Intercept)       aes_T3  
##      1.6587       0.2119  
## 
## Degrees of Freedom: 104 Total (i.e. Null);  103 Residual
##   (9 observations deleted due to missingness)
## Null Deviance:       91.69 
## Residual Deviance: 89.55     AIC: 287.3
## 
## 
## $results
##                                    BIC      crossover crossover 95%      
## Vantage sensitivity STRONG         "277.63" "-3"      ""                 
## E only                             "279.75" NA        ""                 
## Diathesis-stress STRONG            "280.26" "3"       ""                 
## Vantage sensitivity WEAK           "281.94" "-3"      ""                 
## Differential susceptibility STRONG "282.26" "-3.36"   "( -4.29 / -2.43 )"
## G + E only                         "283.36" NA        ""                 
## Diathesis-stress WEAK              "284.38" "3"       ""                 
## Differential susceptibility WEAK   "285.78" "-0.62"   "( -1.57 / 0.33 )" 
## Intercept only                     "293.05" NA        ""                 
## G only                             "295.23" NA        ""                 
##                                    Within observable range?
## Vantage sensitivity STRONG         ""                      
## E only                             ""                      
## Diathesis-stress STRONG            ""                      
## Vantage sensitivity WEAK           ""                      
## Differential susceptibility STRONG "No"                    
## G + E only                         ""                      
## Diathesis-stress WEAK              ""                      
## Differential susceptibility WEAK   "Yes"                   
## Intercept only                     ""                      
## G only                             ""                      
##                                    % of observations below crossover
## Vantage sensitivity STRONG         "0"                              
## E only                             NA                               
## Diathesis-stress STRONG            "0.854368932038835"              
## Vantage sensitivity WEAK           "0.0679611650485437"             
## Differential susceptibility STRONG "0"                              
## G + E only                         NA                               
## Diathesis-stress WEAK              "0.854368932038835"              
## Differential susceptibility WEAK   "0.135922330097087"              
## Intercept only                     NA                               
## G only                             NA                               
## 
## $E_range
## [1] -3  3
# fits[[1]] is the best model (based on BIC)
summary(GxE_test_BIC$fits[[1]]) 
## $fit_main
## 
## Call:
## stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -2.62872  -0.51442  -0.01613   0.52230   2.08558  
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 2.153187   0.200457  10.741  < 2e-16 ***
## G:E         0.034014   0.008353   4.072 9.28e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.7727262)
## 
##     Null deviance: 90.858  on 102  degrees of freedom
## Residual deviance: 78.045  on 101  degrees of freedom
## AIC: 269.73
## 
## Number of Fisher Scoring iterations: 2
## 
## 
## $fit_genes
## 
## Call:
## stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -2.62872  -0.51442  -0.01613   0.52230   2.08558  
## 
## Coefficients: (-1 not defined because of singularities)
##        Estimate Std. Error t value Pr(>|t|)    
## aes_T3   1.0000     0.1061   9.424 1.67e-15 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.7727262)
## 
##     Null deviance: 90.858  on 103  degrees of freedom
## Residual deviance: 78.045  on 101  degrees of freedom
## AIC: 269.73
## 
## Number of Fisher Scoring iterations: 2
## 
## 
## $fit_env
## 
## Call:
## stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -2.62650  -0.51442  -0.01465   0.52434   2.08558  
## 
## Coefficients: (-1 not defined because of singularities)
##       Estimate Std. Error t value Pr(>|t|)    
## ev_T3    1.000      0.242   4.132 7.43e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.7727246)
## 
##     Null deviance: 90.858  on 103  degrees of freedom
## Residual deviance: 78.045  on 101  degrees of freedom
## AIC: 269.73
## 
## Number of Fisher Scoring iterations: 2
plot(GxE_test_BIC$fits[[1]], xlim=c(-3,3), ylim=c(1,4), legend = "bottomright")

9-4. 4時点目のモデル：VS支持

GxE_test_BIC = GxE_interaction_test(data=df, genes=df[,"aes_T4", drop=FALSE], env=df[,"ev_T4", drop = FALSE], formula_noGxE = wb_T4 ~ 1, crossover = c("min","max"), criterion="BIC")
GxE_test_BIC
## $fits
## $fits$vantage_sensitivity_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##     2.26326      0.02742  
## 
## Degrees of Freedom: 98 Total (i.e. Null);  97 Residual
## Null Deviance:       100.6 
## Residual Deviance: 94.74     AIC: 282.6
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## aes_T4  
##      1  
## 
## Degrees of Freedom: 99 Total (i.e. Null);  98 Residual
## Null Deviance:       139.6 
## Residual Deviance: 94.74     AIC: 280.6
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T4  
##     1  
## 
## Degrees of Freedom: 99 Total (i.e. Null);  98 Residual
## Null Deviance:       101.3 
## Residual Deviance: 94.73     AIC: 280.6
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 282.5964
## 
## $true_model_parameters$AICc
## [1] 282.8491
## 
## $true_model_parameters$BIC
## [1] 290.3818
## 
## $true_model_parameters$rank
## [1] 2
## 
## $true_model_parameters$df.residual
## [1] 97
## 
## $true_model_parameters$null.deviance
## [1] 100.5818
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T4 ~ 1 + G * E - G - E
## <environment: 0x000000001c1668d0>
## 
## $crossover
## [1] -3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$diathesis_stress_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##     3.17836      0.02327  
## 
## Degrees of Freedom: 98 Total (i.e. Null);  97 Residual
## Null Deviance:       100.6 
## Residual Deviance: 97.02     AIC: 284.9
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## aes_T4  
##      1  
## 
## Degrees of Freedom: 99 Total (i.e. Null);  98 Residual
## Null Deviance:       108.8 
## Residual Deviance: 97.02     AIC: 282.9
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T4  
##     1  
## 
## Degrees of Freedom: 99 Total (i.e. Null);  98 Residual
## Null Deviance:       103.7 
## Residual Deviance: 96.91     AIC: 282.8
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 284.9489
## 
## $true_model_parameters$AICc
## [1] 285.2015
## 
## $true_model_parameters$BIC
## [1] 292.7342
## 
## $true_model_parameters$rank
## [1] 2
## 
## $true_model_parameters$df.residual
## [1] 97
## 
## $true_model_parameters$null.deviance
## [1] 100.5818
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T4 ~ 1 + G * E - G - E
## <environment: 0x0000000012581a20>
## 
## $crossover
## [1] 3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$diathesis_stress_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##     3.22481      0.54785     -0.06727  
## 
## Degrees of Freedom: 98 Total (i.e. Null);  96 Residual
## Null Deviance:       100.6 
## Residual Deviance: 93.28     AIC: 283.1
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## aes_T4  
##      1  
## 
## Degrees of Freedom: 99 Total (i.e. Null);  98 Residual
## Null Deviance:       191.4 
## Residual Deviance: 93.28     AIC: 279.1
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T4  
##     1  
## 
## Degrees of Freedom: 99 Total (i.e. Null);  98 Residual
## Null Deviance:       99.93 
## Residual Deviance: 93.28     AIC: 279.1
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 283.0528
## 
## $true_model_parameters$AICc
## [1] 283.4783
## 
## $true_model_parameters$BIC
## [1] 293.4332
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 96
## 
## $true_model_parameters$null.deviance
## [1] 100.5818
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T4 ~ 1 + G * E - G
## <environment: 0x000000001a4bfe68>
## 
## $crossover
## [1] 3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$model_GandE_only
## 
## Call:  glm(formula = formula_model_GandE_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
## (Intercept)       aes_T4        ev_T4  
##      1.7356       0.1736       0.1550  
## 
## Degrees of Freedom: 98 Total (i.e. Null);  96 Residual
##   (15 observations deleted due to missingness)
## Null Deviance:       100.6 
## Residual Deviance: 93.87     AIC: 283.7
## 
## $fits$diff_suscept_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##     1.78548      0.02463  
## 
## Degrees of Freedom: 98 Total (i.e. Null);  97 Residual
## Null Deviance:       100.6 
## Residual Deviance: 94.42     AIC: 282.3
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## aes_T4  
##      1  
## 
## Degrees of Freedom: 99 Total (i.e. Null);  98 Residual
## Null Deviance:       221.6 
## Residual Deviance: 94.42     AIC: 280.3
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## crossover      ev_T4  
##    -6.745      1.000  
## 
## Degrees of Freedom: 99 Total (i.e. Null);  97 Residual
## Null Deviance:       221.6 
## Residual Deviance: 94.42     AIC: 282.3
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 284.2555
## 
## $true_model_parameters$AICc
## [1] 284.681
## 
## $true_model_parameters$BIC
## [1] 294.636
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 96
## 
## $true_model_parameters$null.deviance
## [1] 100.5818
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T4 ~ 1 + G * E - G - E
## <environment: 0x000000001accb7b8>
## 
## $crossover
## [1] -6.745432
## 
## $crossover_fixed
## [1] FALSE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$vantage_sensitivity_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##    2.260786     0.005736     0.026557  
## 
## Degrees of Freedom: 98 Total (i.e. Null);  96 Residual
## Null Deviance:       100.6 
## Residual Deviance: 94.74     AIC: 284.6
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## aes_T4  
##      1  
## 
## Degrees of Freedom: 99 Total (i.e. Null);  98 Residual
## Null Deviance:       136.8 
## Residual Deviance: 94.74     AIC: 280.6
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T4  
##     1  
## 
## Degrees of Freedom: 99 Total (i.e. Null);  98 Residual
## Null Deviance:       101.4 
## Residual Deviance: 94.73     AIC: 280.6
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 284.5959
## 
## $true_model_parameters$AICc
## [1] 285.0214
## 
## $true_model_parameters$BIC
## [1] 294.9763
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 96
## 
## $true_model_parameters$null.deviance
## [1] 100.5818
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T4 ~ 1 + G * E - G
## <environment: 0x000000001af56c08>
## 
## $crossover
## [1] -3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$diff_suscept_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##      3.2355       0.5403      -0.0660  
## 
## Degrees of Freedom: 98 Total (i.e. Null);  96 Residual
## Null Deviance:       100.6 
## Residual Deviance: 93.27     AIC: 283.1
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## aes_T4  
##      1  
## 
## Degrees of Freedom: 99 Total (i.e. Null);  98 Residual
## Null Deviance:       192.4 
## Residual Deviance: 93.27     AIC: 279.1
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## crossover      ev_T4  
##     3.072      1.000  
## 
## Degrees of Freedom: 99 Total (i.e. Null);  97 Residual
## Null Deviance:       112.3 
## Residual Deviance: 93.27     AIC: 281.1
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 285.0524
## 
## $true_model_parameters$AICc
## [1] 285.6976
## 
## $true_model_parameters$BIC
## [1] 298.028
## 
## $true_model_parameters$rank
## [1] 4
## 
## $true_model_parameters$df.residual
## [1] 95
## 
## $true_model_parameters$null.deviance
## [1] 100.5818
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T4 ~ 1 + G * E - G
## <environment: 0x00000000126212b8>
## 
## $crossover
## [1] 3.072257
## 
## $crossover_fixed
## [1] FALSE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$model_E_only
## 
## Call:  glm(formula = formula_model_E_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
## (Intercept)        ev_T4  
##      2.7062       0.2031  
## 
## Degrees of Freedom: 100 Total (i.e. Null);  99 Residual
##   (13 observations deleted due to missingness)
## Null Deviance:       112.3 
## Residual Deviance: 104.1     AIC: 295.7
## 
## $fits$model_G_only
## 
## Call:  glm(formula = formula_model_G_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
## (Intercept)       aes_T4  
##      1.6679       0.2071  
## 
## Degrees of Freedom: 103 Total (i.e. Null);  102 Residual
##   (10 observations deleted due to missingness)
## Null Deviance:       107.4 
## Residual Deviance: 104.5     AIC: 301.7
## 
## $fits$model_intercept_only
## 
## Call:  glm(formula = formula_model_intercept_only, family = family, 
##     data = cbind(data, genes, env))
## 
## Coefficients:
## (Intercept)  
##       2.864  
## 
## Degrees of Freedom: 105 Total (i.e. Null);  105 Residual
##   (8 observations deleted due to missingness)
## Null Deviance:       119.1 
## Residual Deviance: 119.1     AIC: 317.2
## 
## 
## $results
##                                    BIC      crossover crossover 95%      
## Vantage sensitivity STRONG         "290.38" "-3"      ""                 
## Diathesis-stress STRONG            "292.73" "3"       ""                 
## Diathesis-stress WEAK              "293.43" "3"       ""                 
## G + E only                         "294.06" NA        ""                 
## Differential susceptibility STRONG "294.64" "-6.75"   "( -8.35 / -5.15 )"
## Vantage sensitivity WEAK           "294.98" "-3"      ""                 
## Differential susceptibility WEAK   "298.03" "3.07"    "( 1.71 / 4.43 )"  
## E only                             "303.51" NA        ""                 
## G only                             "309.62" NA        ""                 
## Intercept only                     "322.48" NA        ""                 
##                                    Within observable range?
## Vantage sensitivity STRONG         ""                      
## Diathesis-stress STRONG            ""                      
## Diathesis-stress WEAK              ""                      
## G + E only                         ""                      
## Differential susceptibility STRONG "No"                    
## Vantage sensitivity WEAK           ""                      
## Differential susceptibility WEAK   "No"                    
## E only                             ""                      
## G only                             ""                      
## Intercept only                     ""                      
##                                    % of observations below crossover
## Vantage sensitivity STRONG         "0.0303030303030303"             
## Diathesis-stress STRONG            "0.868686868686869"              
## Diathesis-stress WEAK              "1"                              
## G + E only                         NA                               
## Differential susceptibility STRONG "0"                              
## Vantage sensitivity WEAK           "0.0303030303030303"             
## Differential susceptibility WEAK   "1"                              
## E only                             NA                               
## G only                             NA                               
## Intercept only                     NA                               
## 
## $E_range
## [1] -3  3
# fits[[1]] is the best model (based on BIC)
summary(GxE_test_BIC$fits[[1]]) 
## $fit_main
## 
## Call:
## stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -2.32699  -0.68355  -0.03445   0.62442   2.30488  
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  2.26326    0.27521   8.224 8.96e-13 ***
## G:E          0.02742    0.01121   2.445   0.0163 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.9767106)
## 
##     Null deviance: 100.582  on 98  degrees of freedom
## Residual deviance:  94.741  on 97  degrees of freedom
## AIC: 282.6
## 
## Number of Fisher Scoring iterations: 2
## 
## 
## $fit_genes
## 
## Call:
## stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -2.32699  -0.68355  -0.03445   0.62442   2.30488  
## 
## Coefficients: (-1 not defined because of singularities)
##        Estimate Std. Error t value Pr(>|t|)    
## aes_T4   1.0000     0.1476   6.776 9.61e-10 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.9767106)
## 
##     Null deviance: 100.582  on 99  degrees of freedom
## Residual deviance:  94.741  on 97  degrees of freedom
## AIC: 282.6
## 
## Number of Fisher Scoring iterations: 2
## 
## 
## $fit_env
## 
## Call:
## stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -2.31530  -0.67157  -0.02607   0.62922   2.30488  
## 
## Coefficients: (-1 not defined because of singularities)
##       Estimate Std. Error t value Pr(>|t|)  
## ev_T4   1.0000     0.3851   2.596   0.0109 *
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.976589)
## 
##     Null deviance: 100.582  on 99  degrees of freedom
## Residual deviance:  94.729  on 97  degrees of freedom
## AIC: 282.6
## 
## Number of Fisher Scoring iterations: 2
plot(GxE_test_BIC$fits[[1]], xlim=c(-3,3), ylim=c(1,4), legend = "bottomright")

9-5. 追加分析の2時点目：VS支持

GxE_test_BIC = GxE_interaction_test(data=df, genes=df[,"aes_T1", drop=FALSE], env=df[,"ev_T1", drop = FALSE], formula_noGxE = wb_T2 ~ 1, crossover = c("min","max"), criterion="BIC")
GxE_test_BIC
## $fits
## $fits$vantage_sensitivity_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##     2.37622      0.02581  
## 
## Degrees of Freedom: 96 Total (i.e. Null);  95 Residual
## Null Deviance:       80.99 
## Residual Deviance: 75.54     AIC: 257
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## aes_T1  
##      1  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  96 Residual
## Null Deviance:       115.1 
## Residual Deviance: 75.54     AIC: 255
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T1  
##     1  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  96 Residual
## Null Deviance:       81.84 
## Residual Deviance: 75.51     AIC: 255
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 257.0136
## 
## $true_model_parameters$AICc
## [1] 257.2717
## 
## $true_model_parameters$BIC
## [1] 264.7378
## 
## $true_model_parameters$rank
## [1] 2
## 
## $true_model_parameters$df.residual
## [1] 95
## 
## $true_model_parameters$null.deviance
## [1] 80.98722
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T2 ~ 1 + G * E - G - E
## <environment: 0x000000001b0a5cb0>
## 
## $crossover
## [1] -3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$diathesis_stress_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##     3.20302      0.02002  
## 
## Degrees of Freedom: 96 Total (i.e. Null);  95 Residual
## Null Deviance:       80.99 
## Residual Deviance: 77.89     AIC: 260
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## aes_T1  
##      1  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  96 Residual
## Null Deviance:       86.3 
## Residual Deviance: 77.89     AIC: 258
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T1  
##     1  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  96 Residual
## Null Deviance:       83.51 
## Residual Deviance: 77.78     AIC: 257.9
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 259.9909
## 
## $true_model_parameters$AICc
## [1] 260.249
## 
## $true_model_parameters$BIC
## [1] 267.715
## 
## $true_model_parameters$rank
## [1] 2
## 
## $true_model_parameters$df.residual
## [1] 95
## 
## $true_model_parameters$null.deviance
## [1] 80.98722
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T2 ~ 1 + G * E - G - E
## <environment: 0x000000001cb4b060>
## 
## $crossover
## [1] 3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$model_E_only
## 
## Call:  glm(formula = formula_model_E_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
## (Intercept)        ev_T1  
##      2.8403       0.1345  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  96 Residual
##   (16 observations deleted due to missingness)
## Null Deviance:       81.04 
## Residual Deviance: 77    AIC: 260.5
## 
## $fits$model_GandE_only
## 
## Call:  glm(formula = formula_model_GandE_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
## (Intercept)       aes_T1        ev_T1  
##      1.5378       0.2247       0.1364  
## 
## Degrees of Freedom: 96 Total (i.e. Null);  94 Residual
##   (17 observations deleted due to missingness)
## Null Deviance:       80.99 
## Residual Deviance: 74.76     AIC: 258
## 
## $fits$diff_suscept_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##     1.68305      0.02315  
## 
## Degrees of Freedom: 96 Total (i.e. Null);  95 Residual
## Null Deviance:       80.99 
## Residual Deviance: 74.87     AIC: 256.1
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## aes_T1  
##      1  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  96 Residual
## Null Deviance:       241.4 
## Residual Deviance: 74.87     AIC: 254.1
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## crossover      ev_T1  
##     -8.64       1.00  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  95 Residual
## Null Deviance:       241.4 
## Residual Deviance: 74.87     AIC: 256.1
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 258.1493
## 
## $true_model_parameters$AICc
## [1] 258.5841
## 
## $true_model_parameters$BIC
## [1] 268.4482
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 94
## 
## $true_model_parameters$null.deviance
## [1] 80.98722
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T2 ~ 1 + G * E - G - E
## <environment: 0x0000000013ca8578>
## 
## $crossover
## [1] -8.639728
## 
## $crossover_fixed
## [1] FALSE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$vantage_sensitivity_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##     2.42861     -0.13948      0.04769  
## 
## Degrees of Freedom: 96 Total (i.e. Null);  94 Residual
## Null Deviance:       80.99 
## Residual Deviance: 75.12     AIC: 258.5
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## aes_T1  
##      1  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  96 Residual
## Null Deviance:       210.1 
## Residual Deviance: 75.12     AIC: 254.5
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T1  
##     1  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  96 Residual
## Null Deviance:       80.87 
## Residual Deviance: 75.11     AIC: 254.5
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 258.4746
## 
## $true_model_parameters$AICc
## [1] 258.9094
## 
## $true_model_parameters$BIC
## [1] 268.7735
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 94
## 
## $true_model_parameters$null.deviance
## [1] 80.98722
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T2 ~ 1 + G * E - G
## <environment: 0x00000000132a3010>
## 
## $crossover
## [1] -3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$diathesis_stress_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##     3.24377      0.60269     -0.08073  
## 
## Degrees of Freedom: 96 Total (i.e. Null);  94 Residual
## Null Deviance:       80.99 
## Residual Deviance: 75.31     AIC: 258.7
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## aes_T1  
##      1  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  96 Residual
## Null Deviance:       211.9 
## Residual Deviance: 75.31     AIC: 254.7
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T1  
##     1  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  96 Residual
## Null Deviance:       80.68 
## Residual Deviance: 75.24     AIC: 254.6
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 258.7229
## 
## $true_model_parameters$AICc
## [1] 259.1577
## 
## $true_model_parameters$BIC
## [1] 269.0217
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 94
## 
## $true_model_parameters$null.deviance
## [1] 80.98722
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T2 ~ 1 + G * E - G
## <environment: 0x000000001c534400>
## 
## $crossover
## [1] 3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$model_intercept_only
## 
## Call:  glm(formula = formula_model_intercept_only, family = family, 
##     data = cbind(data, genes, env))
## 
## Coefficients:
## (Intercept)  
##       2.972  
## 
## Degrees of Freedom: 98 Total (i.e. Null);  98 Residual
##   (15 observations deleted due to missingness)
## Null Deviance:       81.04 
## Residual Deviance: 81.04     AIC: 265.1
## 
## $fits$model_G_only
## 
## Call:  glm(formula = formula_model_G_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
## (Intercept)       aes_T1  
##      1.7045       0.2187  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  96 Residual
##   (16 observations deleted due to missingness)
## Null Deviance:       80.99 
## Residual Deviance: 78.92     AIC: 262.9
## 
## $fits$diff_suscept_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##     5.03333      0.22271     -0.01493  
## 
## Degrees of Freedom: 96 Total (i.e. Null);  94 Residual
## Null Deviance:       80.99 
## Residual Deviance: 74.74     AIC: 258
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## aes_T1  
##      1  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  96 Residual
## Null Deviance:       243.8 
## Residual Deviance: 74.74     AIC: 254
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## crossover      ev_T1  
##     16.11       1.00  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  95 Residual
## Null Deviance:       494.3 
## Residual Deviance: 74.74     AIC: 256
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 259.9861
## 
## $true_model_parameters$AICc
## [1] 260.6455
## 
## $true_model_parameters$BIC
## [1] 272.8597
## 
## $true_model_parameters$rank
## [1] 4
## 
## $true_model_parameters$df.residual
## [1] 93
## 
## $true_model_parameters$null.deviance
## [1] 80.98722
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T2 ~ 1 + G * E - G
## <environment: 0x0000000019573220>
## 
## $crossover
## [1] 16.10789
## 
## $crossover_fixed
## [1] FALSE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## 
## $results
##                                    BIC      crossover crossover 95%      
## Vantage sensitivity STRONG         "264.74" "-3"      ""                 
## Diathesis-stress STRONG            "267.72" "3"       ""                 
## E only                             "268.23" NA        ""                 
## G + E only                         "268.31" NA        ""                 
## Differential susceptibility STRONG "268.45" "-8.64"   "( -10.2 / -7.08 )"
## Vantage sensitivity WEAK           "268.77" "-3"      ""                 
## Diathesis-stress WEAK              "269.02" "3"       ""                 
## Intercept only                     "270.32" NA        ""                 
## G only                             "270.65" NA        ""                 
## Differential susceptibility WEAK   "272.86" "16.11"   "( 14.57 / 17.65 )"
##                                    Within observable range?
## Vantage sensitivity STRONG         ""                      
## Diathesis-stress STRONG            ""                      
## E only                             ""                      
## G + E only                         ""                      
## Differential susceptibility STRONG "No"                    
## Vantage sensitivity WEAK           ""                      
## Diathesis-stress WEAK              ""                      
## Intercept only                     ""                      
## G only                             ""                      
## Differential susceptibility WEAK   "No"                    
##                                    % of observations below crossover
## Vantage sensitivity STRONG         "0"                              
## Diathesis-stress STRONG            "0.804123711340206"              
## E only                             NA                               
## G + E only                         NA                               
## Differential susceptibility STRONG "0"                              
## Vantage sensitivity WEAK           "0"                              
## Diathesis-stress WEAK              "0.804123711340206"              
## Intercept only                     NA                               
## G only                             NA                               
## Differential susceptibility WEAK   "1"                              
## 
## $E_range
## [1] -3  3
# fits[[1]] is the best model (based on BIC)
summary(GxE_test_BIC$fits[[1]]) 
## $fit_main
## 
## Call:
## stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -2.30531  -0.62788  -0.02788   0.52052   2.10439  
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 2.376221   0.243841   9.745 5.79e-16 ***
## G:E         0.025808   0.009856   2.618   0.0103 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.7951111)
## 
##     Null deviance: 80.987  on 96  degrees of freedom
## Residual deviance: 75.536  on 95  degrees of freedom
## AIC: 257.01
## 
## Number of Fisher Scoring iterations: 2
## 
## 
## $fit_genes
## 
## Call:
## stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -2.30531  -0.62788  -0.02788   0.52052   2.10439  
## 
## Coefficients: (-1 not defined because of singularities)
##        Estimate Std. Error t value Pr(>|t|)    
## aes_T1   1.0000     0.1418   7.052 2.82e-10 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.7951111)
## 
##     Null deviance: 80.987  on 97  degrees of freedom
## Residual deviance: 75.536  on 95  degrees of freedom
## AIC: 257.01
## 
## Number of Fisher Scoring iterations: 2
## 
## 
## $fit_env
## 
## Call:
## stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -2.2793  -0.6062  -0.0166   0.5205   2.1086  
## 
## Coefficients: (-1 not defined because of singularities)
##       Estimate Std. Error t value Pr(>|t|)   
## ev_T1   1.0000     0.3544   2.822  0.00582 **
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.794877)
## 
##     Null deviance: 80.987  on 97  degrees of freedom
## Residual deviance: 75.513  on 95  degrees of freedom
## AIC: 257.01
## 
## Number of Fisher Scoring iterations: 2
plot(GxE_test_BIC$fits[[1]], xlim=c(-3,3), ylim=c(1,4), legend = "bottomright")

9-6. 追加分析の3時点目：VS支持

GxE_test_BIC = GxE_interaction_test(data=df, genes=df[,"aes_T2", drop=FALSE], env=df[,"ev_T2", drop = FALSE], formula_noGxE = wb_T3 ~ 1, crossover = c("min","max"), criterion="BIC")
GxE_test_BIC
## $fits
## $fits$vantage_sensitivity_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##     2.33720      0.02716  
## 
## Degrees of Freedom: 87 Total (i.e. Null);  86 Residual
## Null Deviance:       71.03 
## Residual Deviance: 64.74     AIC: 228.7
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## aes_T2  
##      1  
## 
## Degrees of Freedom: 88 Total (i.e. Null);  87 Residual
## Null Deviance:       100 
## Residual Deviance: 64.74     AIC: 226.7
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T2  
##     1  
## 
## Degrees of Freedom: 88 Total (i.e. Null);  87 Residual
## Null Deviance:       71.31 
## Residual Deviance: 64.74     AIC: 226.7
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 228.7266
## 
## $true_model_parameters$AICc
## [1] 229.0124
## 
## $true_model_parameters$BIC
## [1] 236.1586
## 
## $true_model_parameters$rank
## [1] 2
## 
## $true_model_parameters$df.residual
## [1] 86
## 
## $true_model_parameters$null.deviance
## [1] 71.02864
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T3 ~ 1 + G * E - G - E
## <environment: 0x000000001a684fc0>
## 
## $crossover
## [1] -3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$model_E_only
## 
## Call:  glm(formula = formula_model_E_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
## (Intercept)        ev_T2  
##      2.8110       0.1448  
## 
## Degrees of Freedom: 87 Total (i.e. Null);  86 Residual
##   (26 observations deleted due to missingness)
## Null Deviance:       71.03 
## Residual Deviance: 65.93     AIC: 230.3
## 
## $fits$diathesis_stress_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##     3.21779      0.02309  
## 
## Degrees of Freedom: 87 Total (i.e. Null);  86 Residual
## Null Deviance:       71.03 
## Residual Deviance: 66.5  AIC: 231.1
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## aes_T2  
##      1  
## 
## Degrees of Freedom: 88 Total (i.e. Null);  87 Residual
## Null Deviance:       79.29 
## Residual Deviance: 66.5  AIC: 229.1
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T2  
##     1  
## 
## Degrees of Freedom: 88 Total (i.e. Null);  87 Residual
## Null Deviance:       72.74 
## Residual Deviance: 66.44     AIC: 229
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 231.0838
## 
## $true_model_parameters$AICc
## [1] 231.3695
## 
## $true_model_parameters$BIC
## [1] 238.5158
## 
## $true_model_parameters$rank
## [1] 2
## 
## $true_model_parameters$df.residual
## [1] 86
## 
## $true_model_parameters$null.deviance
## [1] 71.02864
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T3 ~ 1 + G * E - G - E
## <environment: 0x000000001ccf5078>
## 
## $crossover
## [1] 3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$vantage_sensitivity_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##      2.3758      -0.1596       0.0532  
## 
## Degrees of Freedom: 87 Total (i.e. Null);  85 Residual
## Null Deviance:       71.03 
## Residual Deviance: 64.33     AIC: 230.2
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## aes_T2  
##      1  
## 
## Degrees of Freedom: 88 Total (i.e. Null);  87 Residual
## Null Deviance:       199.8 
## Residual Deviance: 64.33     AIC: 226.2
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T2  
##     1  
## 
## Degrees of Freedom: 88 Total (i.e. Null);  87 Residual
## Null Deviance:       70.92 
## Residual Deviance: 64.33     AIC: 226.2
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 230.1672
## 
## $true_model_parameters$AICc
## [1] 230.6492
## 
## $true_model_parameters$BIC
## [1] 240.0766
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 85
## 
## $true_model_parameters$null.deviance
## [1] 71.02864
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T3 ~ 1 + G * E - G
## <environment: 0x00000000185d4610>
## 
## $crossover
## [1] -3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$diff_suscept_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##     1.87494      0.02607  
## 
## Degrees of Freedom: 87 Total (i.e. Null);  86 Residual
## Null Deviance:       71.03 
## Residual Deviance: 64.5  AIC: 228.4
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## aes_T2  
##      1  
## 
## Degrees of Freedom: 88 Total (i.e. Null);  87 Residual
## Null Deviance:       165.6 
## Residual Deviance: 64.5  AIC: 226.4
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## crossover      ev_T2  
##    -6.246      1.000  
## 
## Degrees of Freedom: 88 Total (i.e. Null);  86 Residual
## Null Deviance:       165.6 
## Residual Deviance: 64.5  AIC: 228.4
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 230.3915
## 
## $true_model_parameters$AICc
## [1] 230.8734
## 
## $true_model_parameters$BIC
## [1] 240.3008
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 85
## 
## $true_model_parameters$null.deviance
## [1] 71.02864
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T3 ~ 1 + G * E - G - E
## <environment: 0x00000000180ee550>
## 
## $crossover
## [1] -6.245715
## 
## $crossover_fixed
## [1] FALSE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$model_GandE_only
## 
## Call:  glm(formula = formula_model_GandE_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
## (Intercept)       aes_T2        ev_T2  
##      1.7796       0.1795       0.1474  
## 
## Degrees of Freedom: 87 Total (i.e. Null);  85 Residual
##   (26 observations deleted due to missingness)
## Null Deviance:       71.03 
## Residual Deviance: 64.78     AIC: 230.8
## 
## $fits$diathesis_stress_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##     3.24908      0.31699     -0.02965  
## 
## Degrees of Freedom: 87 Total (i.e. Null);  85 Residual
## Null Deviance:       71.03 
## Residual Deviance: 65.68     AIC: 232
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## aes_T2  
##      1  
## 
## Degrees of Freedom: 88 Total (i.e. Null);  87 Residual
## Null Deviance:       86.77 
## Residual Deviance: 65.68     AIC: 228
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T2  
##     1  
## 
## Degrees of Freedom: 88 Total (i.e. Null);  87 Residual
## Null Deviance:       71.2 
## Residual Deviance: 65.66     AIC: 228
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 231.9918
## 
## $true_model_parameters$AICc
## [1] 232.4737
## 
## $true_model_parameters$BIC
## [1] 241.9011
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 85
## 
## $true_model_parameters$null.deviance
## [1] 71.02864
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T3 ~ 1 + G * E - G
## <environment: 0x000000001b7336b0>
## 
## $crossover
## [1] 3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$diff_suscept_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##     2.56336     -0.28664      0.07518  
## 
## Degrees of Freedom: 87 Total (i.e. Null);  85 Residual
## Null Deviance:       71.03 
## Residual Deviance: 64.28     AIC: 230.1
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## aes_T2  
##      1  
## 
## Degrees of Freedom: 88 Total (i.e. Null);  87 Residual
## Null Deviance:       207.1 
## Residual Deviance: 64.28     AIC: 226.1
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## crossover      ev_T2  
##    -1.736      1.000  
## 
## Degrees of Freedom: 88 Total (i.e. Null);  86 Residual
## Null Deviance:       81.69 
## Residual Deviance: 64.28     AIC: 228.1
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 232.0984
## 
## $true_model_parameters$AICc
## [1] 232.8301
## 
## $true_model_parameters$BIC
## [1] 244.4851
## 
## $true_model_parameters$rank
## [1] 4
## 
## $true_model_parameters$df.residual
## [1] 84
## 
## $true_model_parameters$null.deviance
## [1] 71.02864
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T3 ~ 1 + G * E - G
## <environment: 0x000000001c4718f0>
## 
## $crossover
## [1] -1.735692
## 
## $crossover_fixed
## [1] FALSE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$model_G_only
## 
## Call:  glm(formula = formula_model_G_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
## (Intercept)       aes_T2  
##      1.8768       0.1839  
## 
## Degrees of Freedom: 92 Total (i.e. Null);  91 Residual
##   (21 observations deleted due to missingness)
## Null Deviance:       74.2 
## Residual Deviance: 72.84     AIC: 247.2
## 
## $fits$model_intercept_only
## 
## Call:  glm(formula = formula_model_intercept_only, family = family, 
##     data = cbind(data, genes, env))
## 
## Coefficients:
## (Intercept)  
##       2.899  
## 
## Degrees of Freedom: 104 Total (i.e. Null);  104 Residual
##   (9 observations deleted due to missingness)
## Null Deviance:       91.69 
## Residual Deviance: 91.69     AIC: 287.7
## 
## 
## $results
##                                    BIC      crossover crossover 95%      
## Vantage sensitivity STRONG         "236.16" "-3"      ""                 
## E only                             "237.76" NA        ""                 
## Diathesis-stress STRONG            "238.52" "3"       ""                 
## Vantage sensitivity WEAK           "240.08" "-3"      ""                 
## Differential susceptibility STRONG "240.3"  "-6.25"   "( -7.54 / -4.95 )"
## G + E only                         "240.69" NA        ""                 
## Diathesis-stress WEAK              "241.9"  "3"       ""                 
## Differential susceptibility WEAK   "244.49" "-1.74"   "( -3.01 / -0.46 )"
## G only                             "254.8"  NA        ""                 
## Intercept only                     "293.05" NA        ""                 
##                                    Within observable range?
## Vantage sensitivity STRONG         ""                      
## E only                             ""                      
## Diathesis-stress STRONG            ""                      
## Vantage sensitivity WEAK           ""                      
## Differential susceptibility STRONG "No"                    
## G + E only                         ""                      
## Diathesis-stress WEAK              ""                      
## Differential susceptibility WEAK   "No"                    
## G only                             ""                      
## Intercept only                     ""                      
##                                    % of observations below crossover
## Vantage sensitivity STRONG         "0"                              
## E only                             NA                               
## Diathesis-stress STRONG            "1"                              
## Vantage sensitivity WEAK           "0.0340909090909091"             
## Differential susceptibility STRONG "0"                              
## G + E only                         NA                               
## Diathesis-stress WEAK              "1"                              
## Differential susceptibility WEAK   "0.102272727272727"              
## G only                             NA                               
## Intercept only                     NA                               
## 
## $E_range
## [1] -3  3
# fits[[1]] is the best model (based on BIC)
summary(GxE_test_BIC$fits[[1]]) 
## $fit_main
## 
## Call:
## stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -2.3519  -0.5564  -0.1075   0.5793   2.1536  
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  2.33720    0.21920  10.663  < 2e-16 ***
## G:E          0.02716    0.00940   2.889  0.00489 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.7528396)
## 
##     Null deviance: 71.029  on 87  degrees of freedom
## Residual deviance: 64.744  on 86  degrees of freedom
## AIC: 228.73
## 
## Number of Fisher Scoring iterations: 2
## 
## 
## $fit_genes
## 
## Call:
## stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -2.3519  -0.5564  -0.1075   0.5793   2.1536  
## 
## Coefficients: (-1 not defined because of singularities)
##        Estimate Std. Error t value Pr(>|t|)    
## aes_T2    1.000      0.146   6.847 1.06e-09 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.7528396)
## 
##     Null deviance: 71.029  on 88  degrees of freedom
## Residual deviance: 64.744  on 86  degrees of freedom
## AIC: 228.73
## 
## Number of Fisher Scoring iterations: 2
## 
## 
## $fit_env
## 
## Call:
## stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -2.3409  -0.5404  -0.1072   0.5936   2.1536  
## 
## Coefficients: (-1 not defined because of singularities)
##       Estimate Std. Error t value Pr(>|t|)   
## ev_T2   1.0000     0.3384   2.955  0.00403 **
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.7527469)
## 
##     Null deviance: 71.029  on 88  degrees of freedom
## Residual deviance: 64.736  on 86  degrees of freedom
## AIC: 228.73
## 
## Number of Fisher Scoring iterations: 2
plot(GxE_test_BIC$fits[[1]], xlim=c(-3,3), ylim=c(1,4), legend = "bottomright")

9-7. 追加分析の4時点目：VS支持

GxE_test_BIC = GxE_interaction_test(data=df, genes=df[,"aes_T3", drop=FALSE], env=df[,"ev_T3", drop = FALSE], formula_noGxE = wb_T4 ~ 1, crossover = c("min","max"), criterion="BIC")
GxE_test_BIC
## $fits
## $fits$vantage_sensitivity_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##     2.18623      0.03148  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  96 Residual
## Null Deviance:       112.8 
## Residual Deviance: 102.4     AIC: 288.4
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## aes_T3  
##      1  
## 
## Degrees of Freedom: 98 Total (i.e. Null);  97 Residual
## Null Deviance:       157.8 
## Residual Deviance: 102.4     AIC: 286.4
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T3  
##     1  
## 
## Degrees of Freedom: 98 Total (i.e. Null);  97 Residual
## Null Deviance:       113.1 
## Residual Deviance: 102.4     AIC: 286.4
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 288.4242
## 
## $true_model_parameters$AICc
## [1] 288.6795
## 
## $true_model_parameters$BIC
## [1] 296.1791
## 
## $true_model_parameters$rank
## [1] 2
## 
## $true_model_parameters$df.residual
## [1] 96
## 
## $true_model_parameters$null.deviance
## [1] 112.8478
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T4 ~ 1 + G * E - G - E
## <environment: 0x00000000122cdfd8>
## 
## $crossover
## [1] -3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$model_E_only
## 
## Call:  glm(formula = formula_model_E_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
## (Intercept)        ev_T3  
##      2.7414       0.1942  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  96 Residual
##   (16 observations deleted due to missingness)
## Null Deviance:       112.8 
## Residual Deviance: 103   AIC: 289
## 
## $fits$diathesis_stress_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##     3.29301      0.03123  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  96 Residual
## Null Deviance:       112.8 
## Residual Deviance: 104.1     AIC: 290
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## aes_T3  
##      1  
## 
## Degrees of Freedom: 98 Total (i.e. Null);  97 Residual
## Null Deviance:       130.9 
## Residual Deviance: 104.1     AIC: 288
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T3  
##     1  
## 
## Degrees of Freedom: 98 Total (i.e. Null);  97 Residual
## Null Deviance:       116.2 
## Residual Deviance: 104   AIC: 287.9
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 289.9889
## 
## $true_model_parameters$AICc
## [1] 290.2442
## 
## $true_model_parameters$BIC
## [1] 297.7438
## 
## $true_model_parameters$rank
## [1] 2
## 
## $true_model_parameters$df.residual
## [1] 96
## 
## $true_model_parameters$null.deviance
## [1] 112.8478
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T4 ~ 1 + G * E - G - E
## <environment: 0x000000001c0a08f8>
## 
## $crossover
## [1] 3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$model_GandE_only
## 
## Call:  glm(formula = formula_model_GandE_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
## (Intercept)       aes_T3        ev_T3  
##      1.9973       0.1276       0.1853  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  95 Residual
##   (16 observations deleted due to missingness)
## Null Deviance:       112.8 
## Residual Deviance: 102.4     AIC: 290.4
## 
## $fits$diff_suscept_STRONG
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)          G:E  
##     2.07915      0.03102  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  96 Residual
## Null Deviance:       112.8 
## Residual Deviance: 102.4     AIC: 288.4
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## aes_T3  
##      1  
## 
## Degrees of Freedom: 98 Total (i.e. Null);  97 Residual
## Null Deviance:       173.1 
## Residual Deviance: 102.4     AIC: 286.4
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## crossover      ev_T3  
##    -3.642      1.000  
## 
## Degrees of Freedom: 98 Total (i.e. Null);  96 Residual
## Null Deviance:       173.1 
## Residual Deviance: 102.4     AIC: 288.4
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 290.4115
## 
## $true_model_parameters$AICc
## [1] 290.8416
## 
## $true_model_parameters$BIC
## [1] 300.7513
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 95
## 
## $true_model_parameters$null.deviance
## [1] 112.8478
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T4 ~ 1 + G * E - G - E
## <environment: 0x0000000018f69740>
## 
## $crossover
## [1] -3.641813
## 
## $crossover_fixed
## [1] FALSE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$vantage_sensitivity_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##    2.185734     0.001494     0.031252  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  95 Residual
## Null Deviance:       112.8 
## Residual Deviance: 102.4     AIC: 290.4
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## aes_T3  
##      1  
## 
## Degrees of Freedom: 98 Total (i.e. Null);  97 Residual
## Null Deviance:       157 
## Residual Deviance: 102.4     AIC: 286.4
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T3  
##     1  
## 
## Degrees of Freedom: 98 Total (i.e. Null);  97 Residual
## Null Deviance:       113.1 
## Residual Deviance: 102.4     AIC: 286.4
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 290.4241
## 
## $true_model_parameters$AICc
## [1] 290.8542
## 
## $true_model_parameters$BIC
## [1] 300.764
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 95
## 
## $true_model_parameters$null.deviance
## [1] 112.8478
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T4 ~ 1 + G * E - G
## <environment: 0x0000000019379790>
## 
## $crossover
## [1] -3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$diathesis_stress_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##     3.32046      0.36361     -0.02947  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  95 Residual
## Null Deviance:       112.8 
## Residual Deviance: 102.7     AIC: 290.7
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## aes_T3  
##      1  
## 
## Degrees of Freedom: 98 Total (i.e. Null);  97 Residual
## Null Deviance:       126.6 
## Residual Deviance: 102.7     AIC: 286.7
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## ev_T3  
##     1  
## 
## Degrees of Freedom: 98 Total (i.e. Null);  97 Residual
## Null Deviance:       113 
## Residual Deviance: 102.7     AIC: 286.7
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 290.6713
## 
## $true_model_parameters$AICc
## [1] 291.1014
## 
## $true_model_parameters$BIC
## [1] 301.0112
## 
## $true_model_parameters$rank
## [1] 3
## 
## $true_model_parameters$df.residual
## [1] 95
## 
## $true_model_parameters$null.deviance
## [1] 112.8478
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T4 ~ 1 + G * E - G
## <environment: 0x000000001aeab730>
## 
## $crossover
## [1] 3
## 
## $crossover_fixed
## [1] TRUE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$diff_suscept_WEAK
## $fit_main
## 
## Call:  stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Coefficients:
## (Intercept)            E          G:E  
##     0.81421      0.11629      0.01166  
## 
## Degrees of Freedom: 97 Total (i.e. Null);  95 Residual
## Null Deviance:       112.8 
## Residual Deviance: 102.3     AIC: 290.4
## 
## $fit_genes
## 
## Call:  stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## aes_T3  
##      1  
## 
## Degrees of Freedom: 98 Total (i.e. Null);  97 Residual
## Null Deviance:       161.3 
## Residual Deviance: 102.3     AIC: 286.4
## 
## $fit_env
## 
## Call:  stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Coefficients:
## crossover      ev_T3  
##    -10.45       1.00  
## 
## Degrees of Freedom: 98 Total (i.e. Null);  96 Residual
## Null Deviance:       524.3 
## Residual Deviance: 102.3     AIC: 288.4
## 
## $true_model_parameters
## $true_model_parameters$AIC
## [1] 292.3663
## 
## $true_model_parameters$AICc
## [1] 293.0185
## 
## $true_model_parameters$BIC
## [1] 305.2912
## 
## $true_model_parameters$rank
## [1] 4
## 
## $true_model_parameters$df.residual
## [1] 94
## 
## $true_model_parameters$null.deviance
## [1] 112.8478
## 
## 
## $ylim
## NULL
## 
## $formula
## wb_T4 ~ 1 + G * E - G
## <environment: 0x000000001a444fc8>
## 
## $crossover
## [1] -10.4487
## 
## $crossover_fixed
## [1] FALSE
## 
## $conv
## [1] TRUE
## 
## attr(,"class")
## [1] "LEGIT"
## 
## $fits$model_G_only
## 
## Call:  glm(formula = formula_model_G_only, family = family, data = cbind(data, 
##     genes, env))
## 
## Coefficients:
## (Intercept)       aes_T3  
##      1.6253       0.2116  
## 
## Degrees of Freedom: 99 Total (i.e. Null);  98 Residual
##   (14 observations deleted due to missingness)
## Null Deviance:       113.2 
## Residual Deviance: 111.3     AIC: 300.5
## 
## $fits$model_intercept_only
## 
## Call:  glm(formula = formula_model_intercept_only, family = family, 
##     data = cbind(data, genes, env))
## 
## Coefficients:
## (Intercept)  
##       2.864  
## 
## Degrees of Freedom: 105 Total (i.e. Null);  105 Residual
##   (8 observations deleted due to missingness)
## Null Deviance:       119.1 
## Residual Deviance: 119.1     AIC: 317.2
## 
## 
## $results
##                                    BIC      crossover crossover 95%       
## Vantage sensitivity STRONG         "296.18" "-3"      ""                  
## E only                             "296.73" NA        ""                  
## Diathesis-stress STRONG            "297.74" "3"       ""                  
## G + E only                         "300.72" NA        ""                  
## Differential susceptibility STRONG "300.75" "-3.64"   "( -4.85 / -2.43 )" 
## Vantage sensitivity WEAK           "300.76" "-3"      ""                  
## Diathesis-stress WEAK              "301.01" "3"       ""                  
## Differential susceptibility WEAK   "305.29" "-10.45"  "( -11.64 / -9.26 )"
## G only                             "308.3"  NA        ""                  
## Intercept only                     "322.48" NA        ""                  
##                                    Within observable range?
## Vantage sensitivity STRONG         ""                      
## E only                             ""                      
## Diathesis-stress STRONG            ""                      
## G + E only                         ""                      
## Differential susceptibility STRONG "No"                    
## Vantage sensitivity WEAK           ""                      
## Diathesis-stress WEAK              ""                      
## Differential susceptibility WEAK   "No"                    
## G only                             ""                      
## Intercept only                     ""                      
##                                    % of observations below crossover
## Vantage sensitivity STRONG         "0"                              
## E only                             NA                               
## Diathesis-stress STRONG            "1"                              
## G + E only                         NA                               
## Differential susceptibility STRONG "0"                              
## Vantage sensitivity WEAK           "0.0714285714285714"             
## Diathesis-stress WEAK              "1"                              
## Differential susceptibility WEAK   "0"                              
## G only                             NA                               
## Intercept only                     NA                               
## 
## $E_range
## [1] -3  3
# fits[[1]] is the best model (based on BIC)
summary(GxE_test_BIC$fits[[1]]) 
## $fit_main
## 
## Call:
## stats::glm(formula = formula, family = family, data = data, model = FALSE, 
##     y = FALSE)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -2.56675  -0.71752  -0.09223   0.78074   2.29434  
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  2.18623    0.24026   9.099 1.28e-14 ***
## G:E          0.03148    0.01006   3.128  0.00233 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 1.066755)
## 
##     Null deviance: 112.85  on 97  degrees of freedom
## Residual deviance: 102.41  on 96  degrees of freedom
## AIC: 288.42
## 
## Number of Fisher Scoring iterations: 2
## 
## 
## $fit_genes
## 
## Call:
## stats::glm(formula = formula_b, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -2.56675  -0.71752  -0.09223   0.78074   2.29434  
## 
## Coefficients: (-1 not defined because of singularities)
##        Estimate Std. Error t value Pr(>|t|)    
## aes_T3   1.0000     0.1388   7.204 1.32e-10 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 1.066755)
## 
##     Null deviance: 112.85  on 98  degrees of freedom
## Residual deviance: 102.41  on 96  degrees of freedom
## AIC: 288.42
## 
## Number of Fisher Scoring iterations: 2
## 
## 
## $fit_env
## 
## Call:
## stats::glm(formula = formula_c, family = family, data = data, 
##     model = FALSE, y = FALSE)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -2.56331  -0.71601  -0.09173   0.78066   2.29434  
## 
## Coefficients: (-1 not defined because of singularities)
##       Estimate Std. Error t value Pr(>|t|)   
## ev_T3   1.0000     0.3162   3.162   0.0021 **
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 1.066751)
## 
##     Null deviance: 112.85  on 98  degrees of freedom
## Residual deviance: 102.41  on 96  degrees of freedom
## AIC: 288.42
## 
## Number of Fisher Scoring iterations: 2
plot(GxE_test_BIC$fits[[1]], xlim=c(-3,3), ylim=c(1,4), legend = "bottomright")

分析は以上です